Changeset 7403 for branches/2016/dev_merge_2016
- Timestamp:
- 2016-11-30T17:56:53+01:00 (8 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM
- Files:
-
- 7 deleted
- 118 edited
- 14 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
r5656 r7403 34 34 %USER_INC -I%XIOS_ROOT/inc %NCDF_INC %MPI_INTEL -I/srv/lib/zlib-last/include 35 35 %USER_LIB -L%XIOS_ROOT/lib -lxios %NCDF_LIB -L/srv/lib/zlib-last/lib -lz 36 %CC icc 37 %CFLAGS -O0 -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_cfg
r4147 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! GYRE_PISCES: Configuration namelist used to overwrite SHARED/namelist_pisces_ref 2 !! PISCES (key_pisces) reference namelist (see below for key_pisces_reduced) 3 !! 1 - air-sea exchange (nampisext) 4 !! 2 - biological parameters (nampisbio) 5 !! 3 - parameters for nutrient limitations (nampislim) 6 !! 4 - parameters for phytoplankton (nampisprod,nampismort) 7 !! 5 - parameters for zooplankton (nampismes,nampiszoo) 8 !! 6 - parameters for remineralization (nampisrem) 9 !! 7 - parameters for calcite chemistry (nampiscal) 10 !! 8 - parameters for inputs deposition (nampissed) 11 !! 11 - Damping (nampisdmp) 12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 13 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 14 &nampismod ! Model used 15 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 16 ln_p4z = .false. 17 ln_p2z = .true. 18 / 19 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 20 &nampisext ! air-sea exchange 21 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 22 / 23 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 24 &nampisatm ! Atmospheric prrssure 25 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 26 / 27 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 28 &nampisbio ! biological parameters 29 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 30 / 31 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 32 &nampislim ! parameters for nutrient limitations 33 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 34 / 35 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 36 &nampisopt ! parameters for optics 37 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 38 / 39 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 40 &nampisprod ! parameters for phytoplankton growth 41 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 42 / 43 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 44 &nampismort ! parameters for phytoplankton sinks 45 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 46 / 47 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 48 &nampismes ! parameters for mesozooplankton 49 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 50 / 51 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 52 &nampiszoo ! parameters for microzooplankton 53 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 54 / 55 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 56 &nampisfer ! parameters for iron chemistry 57 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 58 / 59 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 60 &nampisrem ! parameters for remineralization 61 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 62 / 63 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 64 &nampiscal ! parameters for Calcite chemistry 65 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 66 / 67 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 68 &nampissbc ! parameters for inputs deposition 69 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 70 / 71 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 72 &nampisice ! Prescribed sea ice tracers 73 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 74 / 75 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 76 &nampisdmp ! Damping 77 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 78 / 79 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 80 &nampismass ! Mass conservation 81 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 82 / 83 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 84 !! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists 85 !! 1 - biological parameters for phytoplankton (namlobphy) 86 !! 2 - biological parameters for nutrients (namlobnut) 87 !! 3 - biological parameters for zooplankton (namlobzoo) 88 !! 4 - biological parameters for detritus (namlobdet) 89 !! 5 - biological parameters for DOM (namlobdom) 90 !! 6 - parameters from aphotic layers to sediment (namlobsed) 91 !! 7 - general coefficients (namlobrat) 92 !! 8 - optical parameters (namlobopt) 93 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 3 94 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 4 95 &namlobphy ! biological parameters for phytoplankton … … 15 106 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 16 107 &namlobdet ! biological parameters for detritus 17 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 108 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 18 109 / 19 110 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg
r5836 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! NEMO-TOP Configuration namelist for GYRE_PISCES configuration used to overwrite SHARED/namelist_top_ref 2 !! NEMO/TOP1 : Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref 3 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 3 4 !----------------------------------------------------------------------- 4 5 &namtrc_run ! run information 5 6 !----------------------------------------------------------------------- 6 nn_writetrc = 60 ! time step frequency for sn_tracer outputs7 7 / 8 8 !----------------------------------------------------------------------- 9 9 &namtrc ! tracers definition 10 10 !----------------------------------------------------------------------- 11 ln_trcdta = .false. ! Initialisation from data input file (T) or not (F)11 jp_bgc = 6 12 12 ! 13 ! ! name ! title of the field ! units ! initial data ! save ! 14 ! ! ! ! ! from file ! or not ! 15 ! ! ! ! ! or not ! ! 16 sn_tracer(1) = 'DET' , 'Detritus ', 'mmole-N/m3' , .false. , .false. 17 sn_tracer(2) = 'ZOO' , 'Zooplankton concentration ', 'mmole-N/m3' , .false. , .false. 18 sn_tracer(3) = 'PHY' , 'Phytoplankton concentration', 'mmole-N/m3' , .false. , .false. 19 sn_tracer(4) = 'NO3' , 'Nitrate concentration ', 'mmole-N/m3' , .false. , .true. 20 sn_tracer(5) = 'NH4' , 'Ammonium concentration ', 'mmole-N/m3' , .false. , .false. 21 sn_tracer(6) = 'DOM' , 'Dissolved organic matter ', 'mmole-N/m3' , .false. , .false. 13 ln_pisces = .true. 14 ln_age = .false. 15 ln_cfc11 = .false. 16 ln_cfc12 = .false. 17 ln_c14 = .false. 18 ln_my_trc = .false. 19 ! 20 ! ! ! ! ! 21 ! ! name ! title of the field ! units ! initial data from file or not ! 22 ! ! ! ! ! 23 sn_tracer(1) = 'DET' , 'Detritus ', 'mmole-N/m3' , .false. 24 sn_tracer(2) = 'ZOO' , 'Zooplankton concentration ', 'mmole-N/m3' , .false. 25 sn_tracer(3) = 'PHY' , 'Phytoplankton concentration', 'mmole-N/m3' , .false. 26 sn_tracer(4) = 'NO3' , 'Nitrate concentration ', 'mmole-N/m3' , .false. 27 sn_tracer(5) = 'NH4' , 'Ammonium concentration ', 'mmole-N/m3' , .false. 28 sn_tracer(6) = 'DOM' , 'Dissolved organic matter ', 'mmole-N/m3' , .false. 22 29 / 23 30 !----------------------------------------------------------------------- 24 &namtrc_adv ! advection scheme for passive tracer 25 !----------------------------------------------------------------------- 31 &namtrc_dta ! Initialisation from data input file 32 !----------------------------------------------------------------------- 33 / 26 34 ln_trcadv_fct = .true. ! FCT scheme 27 nn_fct_h = 2 ! =2/4, horizontal 2nd / 4th order 28 nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order 35 nn_fct_h = 2 ! =2/4, horizontal 2nd / 4th order 36 nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order 29 37 nn_fct_zts = 0 ! >=1, 2nd order FCT scheme with vertical sub-timestepping 30 38 ! ! (number of sub-timestep = nn_fct_zts) 31 39 / 32 40 !----------------------------------------------------------------------- 33 &namtrc_ldf ! lateral diffusion scheme for passive tracer 41 &namtrc_ldf ! lateral diffusion scheme for passive tracer 34 42 !----------------------------------------------------------------------- 35 43 rn_ahtrc_0 = 1000. ! horizontal eddy diffusivity for tracers [m2/s] … … 40 48 / 41 49 !----------------------------------------------------------------------- 42 &namtrc_rad ! treatment of negative concentrations 50 &namtrc_rad ! treatment of negative concentrations 43 51 !----------------------------------------------------------------------- 44 52 ln_trcrad = .false. ! artificially correct negative concentrations (T) or not (F) 45 53 / 46 54 !----------------------------------------------------------------------- 47 &namtrc_dia ! parameters for passive tracer additional diagnostics 55 &namtrc_dmp ! passive tracer newtonian damping 56 !----------------------------------------------------------------------- 57 / 58 !----------------------------------------------------------------------- 59 &namtrc_ice ! Representation of sea ice growth & melt effects 60 !----------------------------------------------------------------------- 61 / 62 !----------------------------------------------------------------------- 63 &namtrc_trd ! diagnostics on tracer trends ('key_trdtrc') 64 ! or mixed-layer trends ('key_trdmld_trc') 48 65 !---------------------------------------------------------------------- 49 nn_writedia = 60 ! time step frequency for diagnostics50 66 / 51 67 !---------------------------------------------------------------------- 52 &namtrc_bc 68 &namtrc_bc ! data for boundary conditions 53 69 !----------------------------------------------------------------------- 54 70 / 71 !---------------------------------------------------------------------- 72 &namtrc_bdy ! Setup of tracer boundary conditions 73 !----------------------------------------------------------------------- 74 / -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm
r5930 r7403 1 bld::tool::fppkeys key_zdftke key_top key_ pisces_reduced key_mpp_mpi1 bld::tool::fppkeys key_zdftke key_top key_mpp_mpi -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
r5385 r7403 176 176 <field field_ref="CO3sat" /> 177 177 <field field_ref="PAR" /> 178 <field field_ref="PPPHY " />179 <field field_ref="PPPHY 2" />178 <field field_ref="PPPHYN" /> 179 <field field_ref="PPPHYD" /> 180 180 <field field_ref="PPNEWN" /> 181 181 <field field_ref="PPNEWD" /> -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces_cfg
r4147 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! PISCES : Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_pis_ref 3 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! PISCES reference namelist 3 !! 1 - air-sea exchange (nampisext) 4 !! 2 - biological parameters (nampisbio) 5 !! 3 - parameters for nutrient limitations (nampislim) 6 !! 4 - parameters for phytoplankton (nampisprod,nampismort) 7 !! 5 - parameters for zooplankton (nampismes,nampiszoo) 8 !! 6 - parameters for remineralization (nampisrem) 9 !! 7 - parameters for calcite chemistry (nampiscal) 10 !! 8 - parameters for inputs deposition (nampissed) 11 !! 11 - Damping (nampisdmp) 12 !----------------------------------------------------------------------- 13 &nampismod ! Model used 14 !----------------------------------------------------------------------- 15 / 16 !----------------------------------------------------------------------- 17 &nampisext ! air-sea exchange 18 !----------------------------------------------------------------------- 19 / 20 !----------------------------------------------------------------------- 21 &nampisatm ! Atmospheric prrssure 22 !----------------------------------------------------------------------- 23 / 24 !----------------------------------------------------------------------- 25 &nampisbio ! biological parameters 26 !----------------------------------------------------------------------- 27 / 28 !----------------------------------------------------------------------- 29 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 30 !----------------------------------------------------------------------- 31 / 32 !----------------------------------------------------------------------- 33 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 34 !----------------------------------------------------------------------- 35 / 36 !----------------------------------------------------------------------- 37 &namp5zquota ! parameters for nutrient limitations PISCES quota - ln_p5z 38 !----------------------------------------------------------------------- 39 / 40 !----------------------------------------------------------------------- 41 &nampisopt ! parameters for optics 42 !----------------------------------------------------------------------- 43 / 44 !----------------------------------------------------------------------- 45 &namp4zprod ! parameters for phytoplankton growth for PISCES std - ln_p4z 46 !----------------------------------------------------------------------- 47 / 4 48 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 5 &namp isext ! air-sea exchange49 &namp5zprod ! parameters for phytoplankton growth for PISCES quota - ln_p5z 6 50 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 7 51 / 8 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''9 &namp isatm ! Atmospheric prrssure10 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,52 !----------------------------------------------------------------------- 53 &namp4zmort ! parameters for phytoplankton sinks for PISCES std - ln_p4z 54 !----------------------------------------------------------------------- 11 55 / 12 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''13 &namp isbio ! biological parameters14 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,56 !----------------------------------------------------------------------- 57 &namp5zmort ! parameters for phytoplankton sinks for PISCES quota - ln_p5z 58 !----------------------------------------------------------------------- 15 59 / 16 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''17 &namp islim ! parameters for nutrient limitations18 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,60 !----------------------------------------------------------------------- 61 &namp4zmes ! parameters for mesozooplankton for PISCES std - ln_p4z 62 !----------------------------------------------------------------------- 19 63 / 20 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 21 &nampisopt ! parameters for optics 22 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 23 / 24 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 25 &nampisprod ! parameters for phytoplankton growth 26 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 64 !----------------------------------------------------------------------- 65 &namp5zmes ! parameters for mesozooplankton 66 !----------------------------------------------------------------------- 27 67 / 28 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''29 &namp ismort ! parameters for phytoplankton sinks30 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,68 !----------------------------------------------------------------------- 69 &namp4zzoo ! parameters for microzooplankton for PISCES std - ln_p4z 70 !----------------------------------------------------------------------- 31 71 / 32 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''33 &namp ismes ! parameters for mesozooplankton34 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,72 !----------------------------------------------------------------------- 73 &namp5zzoo ! parameters for microzooplankton 74 !----------------------------------------------------------------------- 35 75 / 36 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''37 &nampis zoo ! parameters for microzooplankton38 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,76 !----------------------------------------------------------------------- 77 &nampisfer ! parameters for iron chemistry 78 !----------------------------------------------------------------------- 39 79 / 40 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 41 &nampisfer ! parameters for iron chemistry 42 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 43 / 44 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 80 !----------------------------------------------------------------------- 45 81 &nampisrem ! parameters for remineralization 46 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,82 !----------------------------------------------------------------------- 47 83 / 48 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 84 !----------------------------------------------------------------------- 85 &nampispoc ! parameters for organic particles 86 !----------------------------------------------------------------------- 87 / 88 !----------------------------------------------------------------------- 49 89 &nampiscal ! parameters for Calcite chemistry 50 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,90 !----------------------------------------------------------------------- 51 91 / 52 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''92 !----------------------------------------------------------------------- 53 93 &nampissbc ! parameters for inputs deposition 54 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,94 !----------------------------------------------------------------------- 55 95 / 56 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 96 !----------------------------------------------------------------------- 97 &nampislig ! Namelist parameters for ligands, nampislig 98 !----------------------------------------------------------------------- 99 / 100 !----------------------------------------------------------------------- 101 &nampisice ! Prescribed sea ice tracers 102 !----------------------------------------------------------------------- 103 / 104 !----------------------------------------------------------------------- 57 105 &nampisdmp ! Damping 58 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,106 !----------------------------------------------------------------------- 59 107 / 60 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''108 !----------------------------------------------------------------------- 61 109 &nampismass ! Mass conservation 62 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,110 !----------------------------------------------------------------------- 63 111 / 112 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 113 !! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists 114 !! 1 - biological parameters for phytoplankton (namlobphy) 115 !! 2 - biological parameters for nutrients (namlobnut) 116 !! 3 - biological parameters for zooplankton (namlobzoo) 117 !! 4 - biological parameters for detritus (namlobdet) 118 !! 5 - biological parameters for DOM (namlobdom) 119 !! 6 - parameters from aphotic layers to sediment (namlobsed) 120 !! 7 - general coefficients (namlobrat) 121 !! 8 - optical parameters (namlobopt) 122 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 123 !----------------------------------------------------------------------- 124 &namlobphy ! biological parameters for phytoplankton 125 !----------------------------------------------------------------------- 126 / 127 !----------------------------------------------------------------------- 128 &namlobnut ! biological parameters for nutrients 129 !----------------------------------------------------------------------- 130 / 131 !----------------------------------------------------------------------- 132 &namlobzoo ! biological parameters for zooplankton 133 !----------------------------------------------------------------------- 134 / 135 !----------------------------------------------------------------------- 136 &namlobdet ! biological parameters for detritus 137 !----------------------------------------------------------------------- 138 / 139 !----------------------------------------------------------------------- 140 &namlobdom ! biological parameters for DOM 141 !----------------------------------------------------------------------- 142 / 143 !----------------------------------------------------------------------- 144 &namlobsed ! parameters from aphotic layers to sediment 145 !----------------------------------------------------------------------- 146 / 147 !----------------------------------------------------------------------- 148 &namlobrat ! general coefficients 149 !----------------------------------------------------------------------- 150 / 151 !----------------------------------------------------------------------- 152 &namlobopt ! optical parameters 153 !----------------------------------------------------------------------- 154 / -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg
r6140 r7403 5 5 &namtrc_run ! run information 6 6 !----------------------------------------------------------------------- 7 ln_top_euler = .true. 7 8 / 8 9 !----------------------------------------------------------------------- 9 10 &namtrc ! tracers definition 10 11 !----------------------------------------------------------------------- 11 ! ! name ! title of the field ! initial data ! initial data ! save ! 12 ! ! ! ! units ! from file ! or not ! 13 ! ! ! ! ! or not ! ! 14 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .true. 15 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .true. 16 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .true. 17 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .true. 18 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. 19 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .true. 20 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. 21 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .true. 22 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .true. 23 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .true. 24 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .true. 25 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .true. 26 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .true. 27 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. 28 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .true. 29 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .true. 30 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .true. 31 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .true. 32 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .true. 33 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .true. 34 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 35 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 36 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. 37 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .true. 12 jp_bgc = 24 13 ! 14 ln_pisces = .true. 15 ln_age = .false. 16 ln_cfc11 = .false. 17 ln_cfc12 = .false. 18 ln_c14 = .false. 19 ln_my_trc = .false. 20 ! 21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ! ! ! ! ! 23 ! ! name ! title of the field ! units ! initial data from file or not ! 24 ! ! ! ! ! 25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. 38 49 / 39 50 !----------------------------------------------------------------------- … … 78 89 / 79 90 !----------------------------------------------------------------------- 80 &namtrc_dia ! parameters for passive tracer additional diagnostics 91 &namtrc_dmp ! passive tracer newtonian damping 92 !----------------------------------------------------------------------- 93 / 94 !----------------------------------------------------------------------- 95 &namtrc_ice ! Representation of sea ice growth & melt effects 96 !----------------------------------------------------------------------- 97 / 98 !----------------------------------------------------------------------- 99 &namtrc_trd ! diagnostics on tracer trends ('key_trdtrc') 100 ! or mixed-layer trends ('key_trdmld_trc') 81 101 !---------------------------------------------------------------------- 82 102 / 83 103 !---------------------------------------------------------------------- 84 &namtrc_bc 104 &namtrc_bc ! data for boundary conditions 85 105 !----------------------------------------------------------------------- 86 106 / 107 !---------------------------------------------------------------------- 108 &namtrc_bdy ! Setup of tracer boundary conditions 109 !----------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm
r5930 r7403 1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_ pisces key_mpp_mpi key_iomput1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_mpp_mpi key_iomput -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
r5385 r7403 108 108 <field field_ref="CO3sat" /> 109 109 <field field_ref="PAR" /> 110 <field field_ref="PPPHY " />111 <field field_ref="PPPHY 2" />110 <field field_ref="PPPHYN" /> 111 <field field_ref="PPPHYD" /> 112 112 <field field_ref="PPNEWN" /> 113 113 <field field_ref="PPNEWD" /> -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_cfg
r4147 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! PISCES : ORCA2_OFF_PISCES configuration namelsit used to overwrite SHARED/namelist_pisces_ref 3 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! PISCES reference namelist 3 !! 1 - air-sea exchange (nampisext) 4 !! 2 - biological parameters (nampisbio) 5 !! 3 - parameters for nutrient limitations (nampislim) 6 !! 4 - parameters for phytoplankton (nampisprod,nampismort) 7 !! 5 - parameters for zooplankton (nampismes,nampiszoo) 8 !! 6 - parameters for remineralization (nampisrem) 9 !! 7 - parameters for calcite chemistry (nampiscal) 10 !! 8 - parameters for inputs deposition (nampissed) 11 !! 11 - Damping (nampisdmp) 12 !----------------------------------------------------------------------- 13 &nampismod ! Model used 14 !----------------------------------------------------------------------- 15 / 16 !----------------------------------------------------------------------- 17 &nampisext ! air-sea exchange 18 !----------------------------------------------------------------------- 19 / 20 !----------------------------------------------------------------------- 21 &nampisatm ! Atmospheric prrssure 22 !----------------------------------------------------------------------- 23 / 24 !----------------------------------------------------------------------- 25 &nampisbio ! biological parameters 26 !----------------------------------------------------------------------- 27 nrdttrc = 4 ! time step frequency for biology 28 / 29 !----------------------------------------------------------------------- 30 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 31 !----------------------------------------------------------------------- 32 / 33 !----------------------------------------------------------------------- 34 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 35 !----------------------------------------------------------------------- 36 / 37 !----------------------------------------------------------------------- 38 &namp5zquota ! parameters for nutrient limitations PISCES quota - ln_p5z 39 !----------------------------------------------------------------------- 40 / 41 !----------------------------------------------------------------------- 42 &nampisopt ! parameters for optics 43 !----------------------------------------------------------------------- 44 / 45 !----------------------------------------------------------------------- 46 &namp4zprod ! parameters for phytoplankton growth for PISCES std - ln_p4z 47 !----------------------------------------------------------------------- 48 / 4 49 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 5 &namp isext ! air-sea exchange50 &namp5zprod ! parameters for phytoplankton growth for PISCES quota - ln_p5z 6 51 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 7 52 / 8 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''9 &namp isatm ! Atmospheric prrssure10 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,53 !----------------------------------------------------------------------- 54 &namp4zmort ! parameters for phytoplankton sinks for PISCES std - ln_p4z 55 !----------------------------------------------------------------------- 11 56 / 12 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 13 &nampisbio ! biological parameters 14 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 15 nrdttrc = 4 ! time step frequency for biology 57 !----------------------------------------------------------------------- 58 &namp5zmort ! parameters for phytoplankton sinks for PISCES quota - ln_p5z 59 !----------------------------------------------------------------------- 16 60 / 17 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''18 &namp islim ! parameters for nutrient limitations19 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,61 !----------------------------------------------------------------------- 62 &namp4zmes ! parameters for mesozooplankton for PISCES std - ln_p4z 63 !----------------------------------------------------------------------- 20 64 / 21 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 22 &nampisopt ! parameters for optics 23 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 24 / 25 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 26 &nampisprod ! parameters for phytoplankton growth 27 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 65 !----------------------------------------------------------------------- 66 &namp5zmes ! parameters for mesozooplankton 67 !----------------------------------------------------------------------- 28 68 / 29 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''30 &namp ismort ! parameters for phytoplankton sinks31 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,69 !----------------------------------------------------------------------- 70 &namp4zzoo ! parameters for microzooplankton for PISCES std - ln_p4z 71 !----------------------------------------------------------------------- 32 72 / 33 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''34 &namp ismes ! parameters for mesozooplankton35 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,73 !----------------------------------------------------------------------- 74 &namp5zzoo ! parameters for microzooplankton 75 !----------------------------------------------------------------------- 36 76 / 37 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''38 &nampis zoo ! parameters for microzooplankton39 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,77 !----------------------------------------------------------------------- 78 &nampisfer ! parameters for iron chemistry 79 !----------------------------------------------------------------------- 40 80 / 41 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 42 &nampisfer ! parameters for iron chemistry 43 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 44 / 45 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 81 !----------------------------------------------------------------------- 46 82 &nampisrem ! parameters for remineralization 47 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,83 !----------------------------------------------------------------------- 48 84 / 49 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 85 !----------------------------------------------------------------------- 86 &nampispoc ! parameters for organic particles 87 !----------------------------------------------------------------------- 88 / 89 !----------------------------------------------------------------------- 50 90 &nampiscal ! parameters for Calcite chemistry 51 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,91 !----------------------------------------------------------------------- 52 92 / 53 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''93 !----------------------------------------------------------------------- 54 94 &nampissbc ! parameters for inputs deposition 55 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,95 !----------------------------------------------------------------------- 56 96 / 57 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 97 !----------------------------------------------------------------------- 98 &nampislig ! Namelist parameters for ligands, nampislig 99 !----------------------------------------------------------------------- 100 / 101 !----------------------------------------------------------------------- 102 &nampisice ! Prescribed sea ice tracers 103 !----------------------------------------------------------------------- 104 / 105 !----------------------------------------------------------------------- 58 106 &nampisdmp ! Damping 59 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,60 nn_pisdmp = 1460 ! Frequency of Relaxation 107 !----------------------------------------------------------------------- 108 nn_pisdmp = 1460 ! Frequency of Relaxation 61 109 / 62 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''110 !----------------------------------------------------------------------- 63 111 &nampismass ! Mass conservation 64 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,112 !----------------------------------------------------------------------- 65 113 / 114 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 115 !! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists 116 !! 1 - biological parameters for phytoplankton (namlobphy) 117 !! 2 - biological parameters for nutrients (namlobnut) 118 !! 3 - biological parameters for zooplankton (namlobzoo) 119 !! 4 - biological parameters for detritus (namlobdet) 120 !! 5 - biological parameters for DOM (namlobdom) 121 !! 6 - parameters from aphotic layers to sediment (namlobsed) 122 !! 7 - general coefficients (namlobrat) 123 !! 8 - optical parameters (namlobopt) 124 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 125 !----------------------------------------------------------------------- 126 &namlobphy ! biological parameters for phytoplankton 127 !----------------------------------------------------------------------- 128 / 129 !----------------------------------------------------------------------- 130 &namlobnut ! biological parameters for nutrients 131 !----------------------------------------------------------------------- 132 / 133 !----------------------------------------------------------------------- 134 &namlobzoo ! biological parameters for zooplankton 135 !----------------------------------------------------------------------- 136 / 137 !----------------------------------------------------------------------- 138 &namlobdet ! biological parameters for detritus 139 !----------------------------------------------------------------------- 140 / 141 !----------------------------------------------------------------------- 142 &namlobdom ! biological parameters for DOM 143 !----------------------------------------------------------------------- 144 / 145 !----------------------------------------------------------------------- 146 &namlobsed ! parameters from aphotic layers to sediment 147 !----------------------------------------------------------------------- 148 / 149 !----------------------------------------------------------------------- 150 &namlobrat ! general coefficients 151 !----------------------------------------------------------------------- 152 / 153 !----------------------------------------------------------------------- 154 &namlobopt ! optical parameters 155 !----------------------------------------------------------------------- 156 / -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg
r6140 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! NEMO/TOP1 : ORCA2_OFF_PISCES configuration namelist used to overwrite SHARED/namelist_top2 !! NEMO/TOP1 : Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref 3 3 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 4 !----------------------------------------------------------------------- 5 5 &namtrc_run ! run information 6 6 !----------------------------------------------------------------------- 7 nn_writetrc = 1460 ! time step frequency for sn_tracer outputs7 ln_top_euler = .true. 8 8 / 9 9 !----------------------------------------------------------------------- 10 10 &namtrc ! tracers definition 11 11 !----------------------------------------------------------------------- 12 jp_bgc = 24 12 13 ! 13 ! ! name ! title of the field ! units ! initial data ! save ! 14 ! ! ! ! ! from file ! or not ! 15 ! ! ! ! ! or not ! ! 16 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .true. 17 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .true. 18 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .true. 19 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .true. 20 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. 21 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .true. 22 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. 23 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .true. 24 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .true. 25 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .false. , .true. 26 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .true. 27 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .true. 28 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .true. 29 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. 30 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .true. 31 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .true. 32 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .true. 33 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .true. 34 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .true. 35 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .true. 36 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 37 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 38 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. 39 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .true. 14 ln_pisces = .true. 15 ln_my_trc = .false. 16 ln_age = .false. 17 ln_cfc11 = .false. 18 ln_cfc12 = .false. 19 ln_c14 = .false. 20 ! 21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ! ! ! ! ! 23 ! ! name ! title of the field ! units ! initial data from file or not ! 24 ! ! ! ! ! 25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. 40 49 / 41 50 !----------------------------------------------------------------------- 42 51 &namtrc_dta ! Initialisation from data input file 43 52 !----------------------------------------------------------------------- 44 !45 53 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 46 54 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 47 sn_trcdta(1) = 'data_DIC_nomask' , -12 , 'DIC' , .false. , .true. , 'yearly' , '' , '' , '' 48 sn_trcdta(2) = 'data_Alkalini_nomask' , -12 , 'Alkalini', .false. , .true. , 'yearly' , '' , '' , '' 49 sn_trcdta(3) = 'data_O2_nomask' , -1 , 'O2' , .true. , .true. , 'yearly' , '' , '' , '' 50 sn_trcdta(5) = 'data_PO4_nomask' , -1 , 'PO4' , .true. , .true. , 'yearly' , '' , '' , '' 51 sn_trcdta(7) = 'data_Si_nomask' , -1 , 'Si' , .true. , .true. , 'yearly' , '' , '' , '' 52 sn_trcdta(14) = 'data_Fer_nomask' , -12 , 'Fer' , .false. , .true. , 'yearly' , '' , '' , '' 53 sn_trcdta(23) = 'data_NO3_nomask' , -1 , 'NO3' , .true. , .true. , 'yearly' , '' , '' , '' 54 ! 55 cn_dir = './' ! root directory for the location of the data files 55 sn_trcdta(1) = 'data_DIC_nomask' , -12 , 'DIC' , .false. , .true. , 'yearly' , '' , '' , '' 56 sn_trcdta(2) = 'data_Alkalini_nomask' , -12 , 'Alkalini', .false. , .true. , 'yearly' , '' , '' , '' 57 sn_trcdta(3) = 'data_O2_nomask' , -1 , 'O2' , .true. , .true. , 'yearly' , '' , '' , '' 58 sn_trcdta(5) = 'data_PO4_nomask' , -1 , 'PO4' , .true. , .true. , 'yearly' , '' , '' , '' 59 sn_trcdta(7) = 'data_Si_nomask' , -1 , 'Si' , .true. , .true. , 'yearly' , '' , '' , '' 60 sn_trcdta(10) = 'data_DOC_nomask' , -12 , 'DOC' , .false. , .true. , 'yearly' , '' , '' , '' 61 sn_trcdta(14) = 'data_Fer_nomask' , -12 , 'Fer' , .false. , .true. , 'yearly' , '' , '' , '' 62 sn_trcdta(23) = 'data_NO3_nomask' , -1 , 'NO3' , .true. , .true. , 'yearly' , '' , '' , '' 56 63 rn_trfac(1) = 1.0e-06 ! multiplicative factor 57 64 rn_trfac(2) = 1.0e-06 ! - - - - … … 59 66 rn_trfac(5) = 122.0e-06 ! - - - - 60 67 rn_trfac(7) = 1.0e-06 ! - - - - 68 rn_trfac(10) = 1.0 ! - - - - 61 69 rn_trfac(14) = 1.0 ! - - - - 62 70 rn_trfac(23) = 7.6e-06 ! - - - - … … 81 89 / 82 90 !----------------------------------------------------------------------- 83 &namtrc_dia ! parameters for passive tracer additional diagnostics 91 &namtrc_dmp ! passive tracer newtonian damping 92 !----------------------------------------------------------------------- 93 / 94 !----------------------------------------------------------------------- 95 &namtrc_ice ! Representation of sea ice growth & melt effects 96 !----------------------------------------------------------------------- 97 / 98 !----------------------------------------------------------------------- 99 &namtrc_trd ! diagnostics on tracer trends ('key_trdtrc') 100 ! or mixed-layer trends ('key_trdmld_trc') 84 101 !---------------------------------------------------------------------- 85 nn_writedia = 1460 ! time step frequency for diagnostics86 102 / 87 103 !---------------------------------------------------------------------- 88 &namtrc_bc 104 &namtrc_bc ! data for boundary conditions 89 105 !----------------------------------------------------------------------- 90 106 / 107 !---------------------------------------------------------------------- 108 &namtrc_bdy ! Setup of tracer boundary conditions 109 !----------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
r5836 r7403 1 bld::tool::fppkeys key_trabbl key_top key_offline key_ pisces key_iomput key_mpp_mpi1 bld::tool::fppkeys key_trabbl key_top key_offline key_iomput key_mpp_mpi -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/SHARED/field_def.xml
r6472 r7403 41 41 <field id="sstgrad2" long_name="square of module of sst gradient" unit="degC2/m2" /> 42 42 <field id="sbt" long_name="sea bottom temperature" unit="degC" /> 43 <field id="tosmint" long_name="vertical integral of temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" /> 43 44 <field id="sst_wl" long_name="Delta SST of warm layer" unit="degC" /> 44 45 <field id="sst_cs" long_name="Delta SST of cool skin" unit="degC" /> … … 49 50 <field id="sssmax" long_name="max of sea surface salinity" field_ref="sss" operation="maximum" /> 50 51 <field id="sssmin" long_name="min of sea surface salinity" field_ref="sss" operation="minimum" /> 51 <field id="sbs" long_name="sea bottom salinity" unit="1e-3" /> 52 <field id="sbs" long_name="sea bottom salinity" unit="0.001" /> 53 <field id="somint" long_name="vertical integral of salinity times density" standard_name="integral_wrt_depth_of_product_of_density_and_salinity" unit="(kg m2) x (1e-3)" /> 52 54 53 55 <field id="taubot" long_name="bottom stress module" unit="N/m2" /> … … 93 95 94 96 <!-- variables available with key_diaar5 --> 95 <field id="botpres" long_name="Pressure at sea floor" standard_name="sea_water_pressure_at_sea_floor" unit="dbar" /> 97 <field id="botpres" long_name="Sea Water Pressure at Sea Floor" standard_name="sea_water_pressure_at_sea_floor" unit="dbar" /> 98 <field id="sshdyn" long_name="dynamic sea surface height" standard_name="dynamic_sea_surface_height_above_geoid" unit="m" /> 99 <field id="sshdyn2" long_name="square of dynamic sea surface height" standard_name="dynamic_sea_surface_height_above_geoid_squared" unit="m2" > sshdyn * sshdyn </field> 100 <field id="tnpeo" long_name="Tendency of ocean potential energy content" unit="W/m2" /> 96 101 97 102 <!-- variables available with key_vvl --> … … 205 210 <!-- * variable related to ice shelf forcing * --> 206 211 <field id="fwfisf" long_name="Ice shelf melting" unit="Kg/m2/s" /> 207 <field id="qisf" long_name="Ice Shelf Heat Flux" unit="W/m2" /> 212 <field id="fwfisf3d" long_name="Ice shelf melting" unit="kg/m2/s" grid_ref="grid_T_3D" /> 213 <field id="qlatisf" long_name="Ice shelf latent heat flux" unit="W/m2" /> 214 <field id="qlatisf3d" long_name="Ice shelf latent heat flux" unit="W/m2" grid_ref="grid_T_3D" /> 215 <field id="qhcisf" long_name="Ice shelf heat content flux" unit="W/m2" /> 216 <field id="qhcisf3d" long_name="Ice shelf heat content flux" unit="W/m2" grid_ref="grid_T_3D" /> 208 217 <field id="isfgammat" long_name="transfert coefficient for isf (temperature) " unit="m/s" /> 209 218 <field id="isfgammas" long_name="transfert coefficient for isf (salinity) " unit="m/s" /> … … 418 427 <field id="utbl" long_name="zonal current in the Losh tbl" unit="m/s" /> 419 428 420 < !-- variables available with key_diaar5 -->421 <field id="u_masstr " long_name="ocean eulerian mass transport along i-axis" standard_name="ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D" />429 <field id="u_masstr" long_name="Ocean Mass X Transport" standard_name="ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D" /> 430 <field id="u_masstr_vint" long_name="vertical integral of ocean eulerian mass transport along i-axis" standard_name="vertical_integral_of_ocean_mass_x_transport" unit="kg/s" /> 422 431 <field id="u_heattr" long_name="ocean eulerian heat transport along i-axis" standard_name="ocean_heat_x_transport" unit="W" /> 423 432 <field id="u_salttr" long_name="ocean eulerian salt transport along i-axis" standard_name="ocean_salt_x_transport" unit="1e-3*kg/s" /> 433 <field id="uadv_heattr" long_name="ocean advective heat transport along i-axis" standard_name="advectice_ocean_heat_x_transport" unit="W" /> 434 <field id="uadv_salttr" long_name="ocean advective salt transport along i-axis" standard_name="advectice_ocean_salt_x_transport" unit="1e-3*kg/s" /> 424 435 <field id="ueiv_heattr" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" /> 436 <field id="ueiv_salttr" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" /> 437 <field id="ueiv_heattr3d" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" grid_ref="grid_U_3D" /> 438 <field id="ueiv_salttr3d" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_U_3D" /> 425 439 <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_diffusion" unit="W" /> 440 <field id="udiff_salttr" long_name="ocean diffusion salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_diffusion" unit="1e-3*kg/s" /> 426 441 </field_group> 427 442 … … 464 479 <field id="v_heattr" long_name="ocean eulerian heat transport along j-axis" standard_name="ocean_heat_y_transport" unit="W" /> 465 480 <field id="v_salttr" long_name="ocean eulerian salt transport along i-axis" standard_name="ocean_salt_y_transport" unit="1e-3*kg/s" /> 481 <field id="vadv_heattr" long_name="ocean advective heat transport along j-axis" standard_name="advectice_ocean_heat_y_transport" unit="W" /> 482 <field id="vadv_salttr" long_name="ocean advective salt transport along j-axis" standard_name="advectice_ocean_salt_y_transport" unit="1e-3*kg/s" /> 466 483 <field id="veiv_heattr" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" /> 484 <field id="veiv_salttr" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" /> 485 <field id="veiv_heattr3d" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" grid_ref="grid_V_3D" /> 486 <field id="veiv_salttr3d" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_V_3D" /> 467 487 <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_diffusion" unit="W" /> 488 <field id="vdiff_salttr" long_name="ocean diffusion salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_diffusion" unit="1e-3*kg/s" /> 468 489 </field_group> 469 490 … … 625 646 626 647 <!-- Poleward transport : ptr --> 627 <field_group id="diaptr" domain_ref="ptr" > 648 <field_group id="diaptr" domain_ref="ptr" > 628 649 <field id="zomsfglo" long_name="Meridional Stream-Function: Global" unit="Sv" grid_ref="gznl_W_3D" /> 629 650 <field id="zomsfatl" long_name="Meridional Stream-Function: Atlantic" unit="Sv" grid_ref="gznl_W_3D" /> … … 631 652 <field id="zomsfind" long_name="Meridional Stream-Function: Indian" unit="Sv" grid_ref="gznl_W_3D" /> 632 653 <field id="zomsfipc" long_name="Meridional Stream-Function: Pacific+Indian" unit="Sv" grid_ref="gznl_W_3D" /> 633 <field id="zotemglo" long_name="Zonal Mean Temperature : Global" unit="deg C" grid_ref="gznl_T_3D" />634 <field id="zotematl" long_name="Zonal Mean Temperature : Atlantic" unit="deg C" grid_ref="gznl_T_3D" />635 <field id="zotempac" long_name="Zonal Mean Temperature : Pacific" unit="deg C" grid_ref="gznl_T_3D" />636 <field id="zotemind" long_name="Zonal Mean Temperature : Indian" unit="deg C" grid_ref="gznl_T_3D" />637 <field id="zotemipc" long_name="Zonal Mean Temperature : Pacific+Indian" unit="deg C" grid_ref="gznl_T_3D" />638 <field id="zosalglo" long_name="Zonal Mean Salinity : Global" unit=" 1e-3" grid_ref="gznl_T_3D" />639 <field id="zosalatl" long_name="Zonal Mean Salinity : Atlantic" unit=" 1e-3" grid_ref="gznl_T_3D" />640 <field id="zosalpac" long_name="Zonal Mean Salinity : Pacific" unit=" 1e-3" grid_ref="gznl_T_3D" />641 <field id="zosalind" long_name="Zonal Mean Salinity : Indian" unit=" 1e-3" grid_ref="gznl_T_3D" />642 <field id="zosalipc" long_name="Zonal Mean Salinity : Pacific+Indian" unit=" 1e-3" grid_ref="gznl_T_3D" />654 <field id="zotemglo" long_name="Zonal Mean Temperature : Global" unit="degree_C" grid_ref="gznl_T_3D" /> 655 <field id="zotematl" long_name="Zonal Mean Temperature : Atlantic" unit="degree_C" grid_ref="gznl_T_3D" /> 656 <field id="zotempac" long_name="Zonal Mean Temperature : Pacific" unit="degree_C" grid_ref="gznl_T_3D" /> 657 <field id="zotemind" long_name="Zonal Mean Temperature : Indian" unit="degree_C" grid_ref="gznl_T_3D" /> 658 <field id="zotemipc" long_name="Zonal Mean Temperature : Pacific+Indian" unit="degree_C" grid_ref="gznl_T_3D" /> 659 <field id="zosalglo" long_name="Zonal Mean Salinity : Global" unit="0.001" grid_ref="gznl_T_3D" /> 660 <field id="zosalatl" long_name="Zonal Mean Salinity : Atlantic" unit="0.001" grid_ref="gznl_T_3D" /> 661 <field id="zosalpac" long_name="Zonal Mean Salinity : Pacific" unit="0.001" grid_ref="gznl_T_3D" /> 662 <field id="zosalind" long_name="Zonal Mean Salinity : Indian" unit="0.001" grid_ref="gznl_T_3D" /> 663 <field id="zosalipc" long_name="Zonal Mean Salinity : Pacific+Indian" unit="0.001" grid_ref="gznl_T_3D" /> 643 664 <field id="zosrfglo" long_name="Zonal Mean Surface" unit="m2" grid_ref="gznl_T_3D" /> 644 665 <field id="zosrfatl" long_name="Zonal Mean Surface : Atlantic" unit="m2" grid_ref="gznl_T_3D" /> … … 647 668 <field id="zosrfipc" long_name="Zonal Mean Surface : Pacific+Indian" unit="m2" grid_ref="gznl_T_3D" /> 648 669 <field id="sophtadv" long_name="Advective Heat Transport" unit="PW" grid_ref="gznl_T_2D" /> 670 <field id="sophtadv_atl" long_name="Advective Heat Transport: Atlantic" unit="PW" grid_ref="gznl_T_2D" /> 671 <field id="sophtadv_pac" long_name="Advective Heat Transport: Pacific" unit="PW" grid_ref="gznl_T_2D" /> 672 <field id="sophtadv_ind" long_name="Advective Heat Transport: Indian" unit="PW" grid_ref="gznl_T_2D" /> 673 <field id="sophtadv_ipc" long_name="Advective Heat Transport: Pacific+Indian" unit="PW" grid_ref="gznl_T_2D" /> 649 674 <field id="sophtldf" long_name="Diffusive Heat Transport" unit="PW" grid_ref="gznl_T_2D" /> 675 <field id="sophtldf_atl" long_name="Diffusive Heat Transport: Atlantic" unit="PW" grid_ref="gznl_T_2D" /> 676 <field id="sophtldf_pac" long_name="Diffusive Heat Transport: Pacific" unit="PW" grid_ref="gznl_T_2D" /> 677 <field id="sophtldf_ind" long_name="Diffusive Heat Transport: Indian" unit="PW" grid_ref="gznl_T_2D" /> 678 <field id="sophtldf_ipc" long_name="Diffusive Heat Transport: Pacific+Indian" unit="PW" grid_ref="gznl_T_2D" /> 679 <field id="sophtove" long_name="Overturning Heat Transport" unit="PW" grid_ref="gznl_T_2D" /> 680 <field id="sophtove_atl" long_name="Overturning Heat Transport: Atlantic" unit="PW" grid_ref="gznl_T_2D" /> 681 <field id="sophtove_pac" long_name="Overturning Heat Transport: Pacific" unit="PW" grid_ref="gznl_T_2D" /> 682 <field id="sophtove_ind" long_name="Overturning Heat Transport: Indian" unit="PW" grid_ref="gznl_T_2D" /> 683 <field id="sophtove_ipc" long_name="Overturning Heat Transport: Pacific+Indian" unit="PW" grid_ref="gznl_T_2D" /> 684 <field id="sophtbtr" long_name="Barotropic Heat Transport" unit="PW" grid_ref="gznl_T_2D" /> 685 <field id="sophtbtr_atl" long_name="Barotropic Heat Transport: Atlantic" unit="PW" grid_ref="gznl_T_2D" /> 686 <field id="sophtbtr_pac" long_name="Barotropic Heat Transport: Pacific" unit="PW" grid_ref="gznl_T_2D" /> 687 <field id="sophtbtr_ind" long_name="Barotropic Heat Transport: Indian" unit="PW" grid_ref="gznl_T_2D" /> 688 <field id="sophtbtr_ipc" long_name="Barotropic Heat Transport: Pacific+Indian" unit="PW" grid_ref="gznl_T_2D" /> 689 <field id="sophteiv" long_name="Heat Transport from mesoscale eddy advection" unit="PW" grid_ref="gznl_T_2D" /> 690 <field id="sophteiv_atl" long_name="Heat Transport from mesoscale eddy advection: Atlantic" unit="PW" grid_ref="gznl_T_2D" /> 691 <field id="sophteiv_pac" long_name="Heat Transport from mesoscale eddy advection: Pacific" unit="PW" grid_ref="gznl_T_2D" /> 692 <field id="sophteiv_ind" long_name="Heat Transport from mesoscale eddy advection: Indian" unit="PW" grid_ref="gznl_T_2D" /> 693 <field id="sophteiv_ipc" long_name="Heat Transport from mesoscale eddy advection: Pacific+Indian" unit="PW" grid_ref="gznl_T_2D" /> 650 694 <field id="sopstadv" long_name="Advective Salt Transport" unit="Giga g/s" grid_ref="gznl_T_2D" /> 695 <field id="sopstadv_atl" long_name="Advective Salt Transport: Atlantic" unit="Giga g/s" grid_ref="gznl_T_2D" /> 696 <field id="sopstadv_pac" long_name="Advective Salt Transport: Pacific" unit="Giga g/s" grid_ref="gznl_T_2D" /> 697 <field id="sopstadv_ind" long_name="Advective Salt Transport: Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 698 <field id="sopstadv_ipc" long_name="Advective Salt Transport: Pacific+Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 699 <field id="sopstove" long_name="Overturning Salt Transport" unit="Giga g/s" grid_ref="gznl_T_2D" /> 700 <field id="sopstove_atl" long_name="Overturning Salt Transport: Atlantic" unit="Giga g/s" grid_ref="gznl_T_2D" /> 701 <field id="sopstove_pac" long_name="Overturning Salt Transport: Pacific" unit="Giga g/s" grid_ref="gznl_T_2D" /> 702 <field id="sopstove_ind" long_name="Overturning Salt Transport: Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 703 <field id="sopstove_ipc" long_name="Overturning Salt Transport: Pacific+Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 704 <field id="sopstbtr" long_name="Barotropic Salt Transport" unit="Giga g/s" grid_ref="gznl_T_2D" /> 705 <field id="sopstbtr_atl" long_name="Barotropic Salt Transport: Atlantic" unit="Giga g/s" grid_ref="gznl_T_2D" /> 706 <field id="sopstbtr_pac" long_name="Barotropic Salt Transport: Pacific" unit="Giga g/s" grid_ref="gznl_T_2D" /> 707 <field id="sopstbtr_ind" long_name="Barotropic Salt Transport: Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 708 <field id="sopstbtr_ipc" long_name="Barotropic Salt Transport: Pacific+Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 651 709 <field id="sopstldf" long_name="Diffusive Salt Transport" unit="Giga g/s" grid_ref="gznl_T_2D" /> 710 <field id="sopstldf_atl" long_name="Diffusive Salt Transport: Atlantic" unit="Giga g/s" grid_ref="gznl_T_2D" /> 711 <field id="sopstldf_pac" long_name="Diffusive Salt Transport: Pacific" unit="Giga g/s" grid_ref="gznl_T_2D" /> 712 <field id="sopstldf_ind" long_name="Diffusive Salt Transport: Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 713 <field id="sopstldf_ipc" long_name="Diffusive Salt Transport: Pacific+Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 714 <field id="sopsteiv" long_name="Salt Transport from mesoscale eddy advection" unit="Giga g/s" grid_ref="gznl_T_2D" /> 715 <field id="sopsteiv_atl" long_name="Salt Transport from mesoscale eddy advection: Atlantic" unit="Giga g/s" grid_ref="gznl_T_2D" /> 716 <field id="sopsteiv_pac" long_name="Salt Transport from mesoscale eddy advection: Pacific" unit="Giga g/s" grid_ref="gznl_T_2D" /> 717 <field id="sopsteiv_ind" long_name="Salt Transport from mesoscale eddy advection: Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 718 <field id="sopsteiv_ipc" long_name="Salt Transport from mesoscale eddy advection: Pacific+Indian" unit="Giga g/s" grid_ref="gznl_T_2D" /> 652 719 </field_group> 653 720 … … 668 735 <field id="ttrd_ad" long_name="temperature-trend: advection" standard_name="tendency_of_sea_water_temperature_due_to_advection" unit="degC/s" > sqrt( ttrd_xad^2 + ttrd_yad^2 + ttrd_zad^2 ) </field> 669 736 <field id="strd_ad" long_name="salinity -trend: advection" standard_name="tendency_of_sea_water_salinity_due_to_advection" unit="1e-3/s" > sqrt( strd_xad^2 + strd_yad^2 + strd_zad^2 ) </field> 737 <field id="ttrd_totad" long_name="temperature-trend: total advection" standard_name="tendency_of_sea_water_salinity_due_to_advection" unit="degC/s" /> 738 <field id="strd_totad" long_name="salinity -trend: total advection" standard_name="tendency_of_sea_water_salinity_due_to_advection" unit="1e-3/s" /> 670 739 <field id="ttrd_sad" long_name="temperature-trend: surface adv. (no-vvl)" unit="degC/s" grid_ref="grid_T_2D" /> 671 740 <field id="strd_sad" long_name="salinity -trend: surface adv. (no-vvl)" unit="1e-3/s" grid_ref="grid_T_2D" /> … … 674 743 <field id="ttrd_zdf" long_name="temperature-trend: vertical diffusion" standard_name="tendency_of_sea_water_temperature_due_to_vertical_mixing" unit="degC/s" /> 675 744 <field id="strd_zdf" long_name="salinity -trend: vertical diffusion" standard_name="tendency_of_sea_water_salinity_due_to_vertical_mixing" unit="1e-3/s" /> 745 <field id="ttrd_evd" long_name="temperature-trend: EVD convection" unit="degC/s" /> 746 <field id="strd_evd" long_name="salinity -trend: EVD convection" unit="1e-3/s" /> 676 747 677 748 <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 749 <field id="ttrd_iso" long_name="temperature-trend: isopycnal diffusion" unit="degC/s" > ttrd_ldf + ttrd_zdf - ttrd_zdfp </field> 750 <field id="strd_iso" long_name="salinity -trend: isopycnal diffusion" unit="1e-3/s" > strd_ldf + strd_zdf - strd_zdfp </field> 678 751 <field id="ttrd_zdfp" long_name="temperature-trend: pure vert. diffusion" unit="degC/s" /> 679 752 <field id="strd_zdfp" long_name="salinity -trend: pure vert. diffusion" unit="1e-3/s" /> … … 692 765 <field id="ttrd_atf" long_name="temperature-trend: asselin time filter" unit="degC/s" /> 693 766 <field id="strd_atf" long_name="salinity -trend: asselin time filter" unit="1e-3/s" /> 767 <field id="ttrd_tot" long_name="temperature-trend: total model trend" unit="degC/s" /> 768 <field id="strd_tot" long_name="salinity -trend: total model trend" unit="1e-3/s" /> 769 770 <!-- Thickness weighted versions: --> 771 <field id="ttrd_xad_e3t" unit="degC/s * m" > ttrd_xad * e3t </field> 772 <field id="strd_xad_e3t" unit="1e-3/s * m" > strd_xad * e3t </field> 773 <field id="ttrd_yad_e3t" unit="degC/s * m" > ttrd_yad * e3t </field> 774 <field id="strd_yad_e3t" unit="1e-3/s * m" > strd_yad * e3t </field> 775 <field id="ttrd_zad_e3t" unit="degC/s * m" > ttrd_zad * e3t </field> 776 <field id="strd_zad_e3t" unit="1e-3/s * m" > strd_zad * e3t </field> 777 <field id="ttrd_ad_e3t" unit="degC/s * m" > ttrd_ad * e3t </field> 778 <field id="strd_ad_e3t" unit="1e-3/s * m" > strd_ad * e3t </field> 779 <field id="ttrd_totad_e3t" unit="degC/s * m" > ttrd_totad * e3t </field> 780 <field id="strd_totad_e3t" unit="1e-3/s * m" > strd_totad * e3t </field> 781 <field id="ttrd_ldf_e3t" unit="degC/s * m" > ttrd_ldf * e3t </field> 782 <field id="strd_ldf_e3t" unit="1e-3/s * m" > strd_ldf * e3t </field> 783 <field id="ttrd_zdf_e3t" unit="degC/s * m" > ttrd_zdf * e3t </field> 784 <field id="strd_zdf_e3t" unit="1e-3/s * m" > strd_zdf * e3t </field> 785 <field id="ttrd_evd_e3t" unit="degC/s * m" > ttrd_evd * e3t </field> 786 <field id="strd_evd_e3t" unit="1e-3/s * m" > strd_evd * e3t </field> 787 788 <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 789 <field id="ttrd_iso_e3t" unit="degC/s * m" > ttrd_iso * e3t </field> 790 <field id="strd_iso_e3t" unit="1e-3/s * m" > strd_iso * e3t </field> 791 <field id="ttrd_zdfp_e3t" unit="degC/s * m" > ttrd_zdfp * e3t </field> 792 <field id="strd_zdfp_e3t" unit="1e-3/s * m" > strd_zdfp * e3t </field> 793 794 <!-- --> 795 <field id="ttrd_dmp_e3t" unit="degC/s * m" > ttrd_dmp * e3t </field> 796 <field id="strd_dmp_e3t" unit="1e-3/s * m" > strd_dmp * e3t </field> 797 <field id="ttrd_bbl_e3t" unit="degC/s * m" > ttrd_bbl * e3t </field> 798 <field id="strd_bbl_e3t" unit="1e-3/s * m" > strd_bbl * e3t </field> 799 <field id="ttrd_npc_e3t" unit="degC/s * m" > ttrd_npc * e3t </field> 800 <field id="strd_npc_e3t" unit="1e-3/s * m" > strd_npc * e3t </field> 801 <field id="ttrd_qns_e3t" unit="degC/s * m" > ttrd_qns * e3t_surf </field> 802 <field id="strd_cdt_e3t" unit="degC/s * m" > strd_cdt * e3t_surf </field> 803 <field id="ttrd_qsr_e3t" unit="degC/s * m" > ttrd_qsr * e3t </field> 804 <field id="ttrd_bbc_e3t" unit="degC/s * m" > ttrd_bbc * e3t </field> 805 <field id="ttrd_atf_e3t" unit="degC/s * m" > ttrd_atf * e3t </field> 806 <field id="strd_atf_e3t" unit="1e-3/s * m" > strd_atf * e3t </field> 807 <field id="ttrd_tot_e3t" unit="degC/s * m" > ttrd_tot * e3t </field> 808 <field id="strd_tot_e3t" unit="1e-3/s * m" > strd_tot * e3t </field> 809 694 810 695 811 <!-- variables available with ln_KE_trd --> … … 785 901 786 902 <field_group id="ptrc_T" grid_ref="grid_T_3D"> 903 <!-- PISCES standard : variables available with ln_p4z --> 787 904 <field id="DIC" long_name="Dissolved inorganic Concentration" unit="mmol/m3" /> 788 <field id="DIC_ E3T" long_name="DIC * E3T" unit="mmol/m2" > DIC * e3t </field >905 <field id="DIC_e3t" long_name="DIC * e3t" unit="mmol/m2" > DIC * e3t </field > 789 906 <field id="Alkalini" long_name="Total Alkalinity Concentration" unit="mmol/m3" /> 790 <field id="Alkalini_ E3T" long_name="Alkalini * E3T" unit="mmol/m2" > Alkalini * e3t </field >907 <field id="Alkalini_e3t" long_name="Alkalini * e3t" unit="mmol/m2" > Alkalini * e3t </field > 791 908 <field id="O2" long_name="Oxygen Concentration" unit="mmol/m3" /> 792 <field id="O2_ E3T" long_name="O2 * E3T" unit="mmol/m2" > O2 * e3t </field >909 <field id="O2_e3t" long_name="O2 * e3t" unit="mmol/m2" > O2 * e3t </field > 793 910 <field id="CaCO3" long_name="Calcite Concentration" unit="mmol/m3" /> 794 <field id="CaCO3_ E3T" long_name="CaCO3 * E3T" unit="mmol/m2" > CaCO3 * e3t </field >911 <field id="CaCO3_e3t" long_name="CaCO3 * e3t" unit="mmol/m2" > CaCO3 * e3t </field > 795 912 <field id="PO4" long_name="Phosphate Concentration" unit="mmol/m3" /> 796 <field id="PO4_ E3T" long_name="PO4 * E3T" unit="mmol/m2" > PO4 * e3t </field >913 <field id="PO4_e3t" long_name="PO4 * e3t" unit="mmol/m2" > PO4 * e3t </field > 797 914 <field id="POC" long_name="Small organic carbon Concentration" unit="mmol/m3" /> 798 <field id="POC_ E3T" long_name="POC * E3T" unit="mmol/m2" > POC * e3t </field >915 <field id="POC_e3t" long_name="POC * e3t" unit="mmol/m2" > POC * e3t </field > 799 916 <field id="Si" long_name="Silicate Concentration" unit="mmol/m3" /> 800 <field id="Si_ E3T" long_name="Si * E3T" unit="mmol/m2" > Si * e3t </field >917 <field id="Si_e3t" long_name="Si * e3t" unit="mmol/m2" > Si * e3t </field > 801 918 <field id="PHY" long_name="(Nano)Phytoplankton Concentration" unit="mmol/m3" /> 802 <field id="PHY_ E3T" long_name="PHY * E3T" unit="mmol/m2" > PHY * e3t </field >919 <field id="PHY_e3t" long_name="PHY * e3t" unit="mmol/m2" > PHY * e3t </field > 803 920 <field id="ZOO" long_name="(Micro)Zooplankton Concentration" unit="mmol/m3" /> 804 <field id="ZOO_ E3T" long_name="ZOO2 * E3T" unit="mmol/m2" > ZOO * e3t </field >921 <field id="ZOO_e3t" long_name="ZOO2 * e3t" unit="mmol/m2" > ZOO * e3t </field > 805 922 <field id="DOC" long_name="Dissolved organic Concentration" unit="mmol/m3" /> 806 <field id="DOC_ E3T" long_name="DOC * E3T" unit="mmol/m2" > DOC * e3t </field >923 <field id="DOC_e3t" long_name="DOC * e3t" unit="mmol/m2" > DOC * e3t </field > 807 924 <field id="PHY2" long_name="Diatoms Concentration" unit="mmol/m3" /> 808 <field id="PHY2_ E3T" long_name="PHY2 * E3T" unit="mmol/m2" > PHY2 * e3t </field >925 <field id="PHY2_e3t" long_name="PHY2 * e3t" unit="mmol/m2" > PHY2 * e3t </field > 809 926 <field id="ZOO2" long_name="Mesozooplankton Concentration" unit="mmol/m3" /> 810 <field id="ZOO2_ E3T" long_name="ZOO2 * E3T" unit="mmol/m2" > ZOO2 * e3t </field >927 <field id="ZOO2_e3t" long_name="ZOO2 * e3t" unit="mmol/m2" > ZOO2 * e3t </field > 811 928 <field id="DSi" long_name="Diatoms Silicate Concentration" unit="mmol/m3" /> 812 <field id="DSi_ E3T" long_name="Dsi * E3T" unit="mmol/m2" > DSi * e3t </field >929 <field id="DSi_e3t" long_name="Dsi * e3t" unit="mmol/m2" > DSi * e3t </field > 813 930 <field id="Fer" long_name="Dissolved Iron Concentration" unit="mmol/m3" /> 814 <field id="Fer_ E3T" long_name="Fer * E3T" unit="mmol/m2" > Fer * e3t </field >931 <field id="Fer_e3t" long_name="Fer * e3t" unit="mmol/m2" > Fer * e3t </field > 815 932 <field id="BFe" long_name="Big iron particles Concentration" unit="mmol/m3" /> 816 <field id="BFe_ E3T" long_name="BFe * E3T" unit="mmol/m2" > BFe * e3t </field >933 <field id="BFe_e3t" long_name="BFe * e3t" unit="mmol/m2" > BFe * e3t </field > 817 934 <field id="GOC" long_name="Big organic carbon Concentration" unit="mmol/m3" /> 818 <field id="GOC_ E3T" long_name="GOC * E3T" unit="mmol/m2" > GOC * e3t </field >935 <field id="GOC_e3t" long_name="GOC * e3t" unit="mmol/m2" > GOC * e3t </field > 819 936 <field id="SFe" long_name="Small iron particles Concentration" unit="mmol/m3" /> 820 <field id="SFe_ E3T" long_name="SFe * E3T" unit="mmol/m2" > SFe * e3t </field >937 <field id="SFe_e3t" long_name="SFe * e3t" unit="mmol/m2" > SFe * e3t </field > 821 938 <field id="DFe" long_name="Diatoms iron Concentration" unit="mmol/m3" /> 822 <field id="DFe_ E3T" long_name="DFe * E3T" unit="mmol/m2" > DFe * e3t </field >939 <field id="DFe_e3t" long_name="DFe * e3t" unit="mmol/m2" > DFe * e3t </field > 823 940 <field id="GSi" long_name="Sinking biogenic Silicate Concentration" unit="mmol/m3" /> 824 <field id="GSi_ E3T" long_name="GSi * E3T" unit="mmol/m2" > GSi * e3t </field >941 <field id="GSi_e3t" long_name="GSi * e3t" unit="mmol/m2" > GSi * e3t </field > 825 942 <field id="NFe" long_name="Nano iron Concentration" unit="mmol/m3" /> 826 <field id="NFe_ E3T" long_name="NFe * E3T" unit="mmol/m2" > NFe * e3t </field >943 <field id="NFe_e3t" long_name="NFe * e3t" unit="mmol/m2" > NFe * e3t </field > 827 944 <field id="NCHL" long_name="Nano chlorophyl Concentration" unit="mg/m3" /> 828 <field id="NCHL_ E3T" long_name="NCHL * E3T" unit="mmol/m2" > NCHL * e3t </field >945 <field id="NCHL_e3t" long_name="NCHL * e3t" unit="mmol/m2" > NCHL * e3t </field > 829 946 <field id="DCHL" long_name="Diatoms chlorophyl Concentration" unit="mg/m3" /> 830 <field id="DCHL_ E3T" long_name="DCHL * E3T" unit="mmol/m2" > DCHL * e3t </field >947 <field id="DCHL_e3t" long_name="DCHL * e3t" unit="mmol/m2" > DCHL * e3t </field > 831 948 <field id="NO3" long_name="Nitrate Concentration" unit="mmol/m3" /> 832 <field id="NO3_ E3T" long_name="NO3 * E3T" unit="mmol/m2" > NO3 * e3t </field >949 <field id="NO3_e3t" long_name="NO3 * e3t" unit="mmol/m2" > NO3 * e3t </field > 833 950 <field id="NH4" long_name="Ammonium Concentration" unit="mmol/m3" /> 834 <field id="NH4_E3T" long_name="NH4 * E3T" unit="mmol/m2" > NH4 * e3t </field > 835 836 <!-- PISCES with Kriest parametisation : variables available with key_kriest --> 837 <field id="Num" long_name="Number of organic particles" unit="1" /> 838 <field id="Num_E3T" long_name="Num * E3T" unit="m" > Num * e3t </field > 839 840 <!-- PISCES light : variables available with key_pisces_reduced --> 951 <field id="NH4_e3t" long_name="NH4 * e3t" unit="mmol/m2" > NH4 * e3t </field > 952 953 <!-- PISCES quota : variables available with ln_p5z --> 954 955 <field id="DON" long_name="Dissolved organic N Concentration" unit="mmol/m3" /> 956 <field id="DON_e3t" long_name="DON * e3t" unit="mmol/m2" > DON * e3t </field > 957 <field id="DOP" long_name="Dissolved organic P Concentration" unit="mmol/m3" /> 958 <field id="DOP_e3t" long_name="DOP * e3t" unit="mmol/m2" > DOP * e3t </field > 959 <field id="PON" long_name="Small PON Concentration" unit="mmol/m3" /> 960 <field id="PON_e3t" long_name="PON * e3t" unit="mmol/m2" > PON * e3t </field > 961 <field id="POP" long_name="Small POP Concentration" unit="mmol/m3" /> 962 <field id="POP_e3t" long_name="POP * e3t" unit="mmol/m2" > POP * e3t </field > 963 <field id="GON" long_name="Big PON Concentration" unit="mmol/m3" /> 964 <field id="GON_e3t" long_name="GON * e3t" unit="mmol/m2" > GON * e3t </field > 965 <field id="GOP" long_name="Big POP Concentration" unit="mmol/m3" /> 966 <field id="GOP_e3t" long_name="GOP * e3t" unit="mmol/m2" > GOP * e3t </field > 967 <field id="PHYN" long_name="Nanophytoplankton N biomass" unit="mmol/m3" /> 968 <field id="PHYN_e3t" long_name="PHYN * e3t" unit="mmol/m2" > PHYN * e3t </field > 969 <field id="PHYP" long_name="Nanophytoplankton P biomass" unit="mmol/m3" /> 970 <field id="PHYP_e3t" long_name="PHYP * e3t" unit="mmol/m2" > PHYP * e3t </field > 971 <field id="DIAN" long_name="Diatoms N biomass" unit="mmol/m3" /> 972 <field id="DIAN_e3t" long_name="DIAN * e3t" unit="mmol/m2" > DIAN * e3t </field > 973 <field id="DIAP" long_name="Diatoms P biomass" unit="mmol/m3" /> 974 <field id="DIAP_e3t" long_name="DIAP * e3t" unit="mmol/m2" > DIAP * e3t </field > 975 <field id="PIC" long_name="Picophytoplankton C biomass" unit="mmol/m3" /> 976 <field id="PIC_e3t" long_name="PIC * e3t" unit="mmol/m2" > PIC * e3t </field > 977 <field id="PICN" long_name="Picophytoplankton N biomass" unit="mmol/m3" /> 978 <field id="PICN_e3t" long_name="PICN * e3t" unit="mmol/m2" > PICN * e3t </field > 979 <field id="PICP" long_name="Picophytoplankton P biomass" unit="mmol/m3" /> 980 <field id="PICP_e3t" long_name="PICP * e3t" unit="mmol/m2" > PICP * e3t </field > 981 <field id="PFe" long_name="Picophytoplankton Fe biomass" unit="mmol/m3" /> 982 <field id="PFe_e3t" long_name="PFe * e3t" unit="mmol/m2" > PFe * e3t </field > 983 <field id="PCHL" long_name="Picophytoplankton Chl biomass" unit="mg/m3" /> 984 <field id="PCHL_e3t" long_name="PCHL * e3t" unit="mmol/m2" > PCHL * e3t </field > 985 986 <!-- PISCES with ligand parametisation : variables available namelist paramter ln_ligand --> 987 <field id="LGW" long_name="Weak ligands concentration" unit="mmol/m3" /> 988 <field id="LGW_e3t" long_name="LGW * e3t" unit="mmol/m2" > LGW * e3t </field > 989 <field id="LFe" long_name="Lithogenic iron concentration" unit="mmol/m3" /> 990 <field id="LFe_e3t" long_name="LFe * e3t" unit="mmol/m2" > LFe * e3t </field > 991 992 <!-- PISCES light : variables available with ln_p2z --> 841 993 <field id="DET" long_name="Detritus" unit="mmol-N/m3" /> 842 <field id="DET_ E3T" long_name="DET * E3T" unit="mmol-N/m2" > DET * e3t </field >994 <field id="DET_e3t" long_name="DET * e3t" unit="mmol-N/m2" > DET * e3t </field > 843 995 <field id="DOM" long_name="Dissolved Organic Matter" unit="mmol-N/m3" /> 844 <field id="DOM_E3T" long_name="DOM * E3T" unit="mmol-N/m2" > DOM * e3t </field > 845 846 <!-- CFC11 : variables available with key_cfc --> 847 <field id="CFC11" long_name="CFC-11 Concentration" unit="umol/m3" /> 848 <field id="CFC11_E3T" long_name="CFC11 * E3T" unit="umol/m2" > CFC11 * e3t </field > 849 <!-- Bomb C14 : variables available with key_c14b --> 850 <field id="C14B" long_name="Bomb C14 Concentration" unit="1" /> 851 <field id="C14B_E3T" long_name="C14B * E3T" unit="m" > C14B * e3t </field > 996 <field id="DOM_e3t" long_name="DOM * e3t" unit="mmol-N/m2" > DOM * e3t </field > 997 998 <!-- CFC11 : variables available with ln_cfc11 --> 999 <field id="CFC11" long_name="Chlorofluoro carbon11 Concentration" unit="umol/m3" /> 1000 <field id="CFC11_e3t" long_name="CFC11 * e3t" unit="umol/m2" > CFC11 * e3t </field > 1001 1002 <!-- CFC12 : variables available with ln_cfc12 --> 1003 <field id="CFC12" long_name="Chlorofluoro carbon12 Concentration" unit="umol/m3" /> 1004 <field id="CFC12_e3t" long_name="CFC12 * e3t" unit="umol/m2" > CFC12 * e3t </field > 1005 1006 <!-- SF6 : variables available with ln_sf6 --> 1007 <field id="SF6" long_name="Sulfur hexafluoride Concentration" unit="umol/m3" /> 1008 <field id="SF6_e3t" long_name="SF6 * e3t" unit="umol/m2" > SF6 * e3t </field > 1009 1010 <!-- C14 : variables available with ln_c14 --> 1011 <field id="RC14" long_name="Radiocarbon ratio" unit="-" /> 1012 <field id="RC14_e3t" long_name="RC14 * e3t" unit="m" > RC14 * e3t </field > 1013 1014 <!-- AGE : variables available with ln_age --> 1015 <field id="Age" long_name="Sea water age since surface contact" unit="yr" /> 1016 <field id="Age_e3t" long_name="Age * e3t" unit="yr * m" > Age * e3t </field > 1017 852 1018 </field_group> 853 1019 … … 860 1026 <field id="PAR" long_name="Photosynthetically Available Radiation" unit="W/m2" grid_ref="grid_T_3D" /> 861 1027 <field id="PARDM" long_name="Daily mean PAR" unit="W/m2" grid_ref="grid_T_3D" /> 862 <field id="PPPHY" long_name="Primary production of nanophyto" unit="mol/m3/s" grid_ref="grid_T_3D" /> 863 <field id="PPPHY2" long_name="Primary production of diatoms" unit="mol/m3/s" grid_ref="grid_T_3D" /> 864 <field id="PPNEWN" long_name="New Primary production of nanophyto" unit="mol/m3/s" grid_ref="grid_T_3D" /> 865 <field id="PPNEWD" long_name="New Primary production of diatoms" unit="mol/m3/s" grid_ref="grid_T_3D" /> 866 <field id="PBSi" long_name="Primary production of Si diatoms" unit="mol/m3/s" grid_ref="grid_T_3D" /> 867 <field id="PFeN" long_name="Primary production of nano iron" unit="mol/m3/s" grid_ref="grid_T_3D" /> 1028 <field id="PPPHYN" long_name="Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1029 <field id="PPPHYP" long_name="Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1030 <field id="PPPHYD" long_name="Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1031 <field id="PPNEWN" long_name="New Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1032 <field id="PPNEWP" long_name="New Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1033 <field id="PPNEWD" long_name="New Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1034 <field id="PBSi" long_name="Primary production of Si diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1035 <field id="PFeN" long_name="Primary production of nano iron" unit="molC/m3/s" grid_ref="grid_T_3D" /> 1036 <field id="PFeP" long_name="Primary production of pico iron" unit="molC/m3/s" grid_ref="grid_T_3D" /> 868 1037 <field id="PFeD" long_name="Primary production of diatoms iron" unit="mol/m3/s" grid_ref="grid_T_3D" /> 869 1038 <field id="xfracal" long_name="Calcifying fraction" unit="1" grid_ref="grid_T_3D" /> … … 874 1043 <field id="REMIN" long_name="Oxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" /> 875 1044 <field id="DENIT" long_name="Anoxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" /> 1045 <field id="REMINP" long_name="Oxic remineralization rate of POC" unit="d-1" grid_ref="grid_T_3D" /> 1046 <field id="REMING" long_name="Oxic remineralization rate of GOC" unit="d-1" grid_ref="grid_T_3D" /> 876 1047 <field id="Nfix" long_name="Nitrogen fixation" unit="mol/m3/s" grid_ref="grid_T_3D" /> 877 1048 <field id="Mumax" long_name="Maximum growth rate" unit="s-1" grid_ref="grid_T_3D" /> 878 1049 <field id="MuN" long_name="Realized growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" /> 1050 <field id="MuP" long_name="Realized growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" /> 879 1051 <field id="MuD" long_name="Realized growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" /> 1052 <field id="MunetN" long_name="Net growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" /> 1053 <field id="MunetP" long_name="Net growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" /> 1054 <field id="MunetD" long_name="Net growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" /> 880 1055 <field id="LNnut" long_name="Nutrient limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 1056 <field id="LPnut" long_name="Nutrient limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 881 1057 <field id="LDnut" long_name="Nutrient limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 882 1058 <field id="LNFe" long_name="Iron limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 1059 <field id="LPFe" long_name="Iron limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 883 1060 <field id="LDFe" long_name="Iron limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 884 1061 <field id="LNlight" long_name="Light limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 1062 <field id="LPlight" long_name="Light limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 885 1063 <field id="LDlight" long_name="Light limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 1064 <field id="SIZEN" long_name="Mean relative size of nanophyto." unit="-" grid_ref="grid_T_3D" /> 1065 <field id="SIZEP" long_name="Mean relative size of picophyto." unit="-" grid_ref="grid_T_3D" /> 1066 <field id="SIZED" long_name="Mean relative size of diatoms" unit="-" grid_ref="grid_T_3D" /> 886 1067 <field id="Fe2" long_name="Iron II concentration" unit="nmol/m3" grid_ref="grid_T_3D" /> 887 1068 <field id="Fe3" long_name="Iron III concentration" unit="nmol/m3" grid_ref="grid_T_3D" /> … … 896 1077 <field id="Sdenit" long_name="Nitrate reduction in the sediments" unit="mol/m2/s" /> 897 1078 <field id="Ironice" long_name="Iron input/uptake due to sea ice" unit="mol/m2/s" /> 1079 <field id="SedCal" long_name="Calcite burial in the sediments" unit="molC/m2/s" /> 1080 <field id="SedSi" long_name="Silicon burial in the sediments" unit="molSi/m2/s" /> 1081 <field id="SedC" long_name="Organic C burial in the sediments" unit="molC/m2/s" /> 898 1082 <field id="HYDR" long_name="Iron input from hydrothemal vents" unit="mol/m2/s" grid_ref="grid_T_3D" /> 899 1083 <field id="EPC100" long_name="Export of carbon particles at 100 m" unit="mol/m2/s" /> … … 914 1098 <field id="Ironsed" long_name="Iron deposition from sediment" unit="mol/m2/s" grid_ref="grid_T_3D" /> 915 1099 916 917 <!-- PISCES with Kriest parametisation : variables available with key_kriest -->918 <field id="EPN100" long_name="Particulate number flux at 100 m" unit="mol/m2/s" />919 <field id="EXPN" long_name="Particulate number flux" unit="mol/m2/s" grid_ref="grid_T_3D" />920 <field id="XNUM" long_name="Number of particles in aggregats" unit="1" grid_ref="grid_T_3D" />921 <field id="WSC" long_name="sinking speed of mass flux" unit="m2/s" grid_ref="grid_T_3D" />922 <field id="WSN" long_name="sinking speed of number flux" unit="m2/s" grid_ref="grid_T_3D" />923 924 1100 <!-- dbio_T on T grid : variables available with key_diaar5 --> 925 1101 <field id="TPP" long_name="Total Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D" /> … … 930 1106 <field id="ZO2MIN" long_name="Depth of oxygen minimum concentration" unit="m" /> 931 1107 <field id="INTNFIX" long_name="Nitrogen fixation rate : vert. integrated" unit="mol/m2/s" /> 932 <field id="INTPPPHY " long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s" />933 <field id="INTPPPHY 2" long_name="Vertically integrated primary production by diatom" unit="mol/m2/s" />1108 <field id="INTPPPHYN" long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s" /> 1109 <field id="INTPPPHYD" long_name="Vertically integrated primary production by diatom" unit="mol/m2/s" /> 934 1110 <field id="INTPP" long_name="Vertically integrated primary production by phyto" unit="mol/m2/s" /> 935 1111 <field id="INTPNEW" long_name="Vertically integrated new primary production" unit="mol/m2/s" /> … … 961 1137 <field id="TDETSED" long_name="TDETSED" unit="" /> 962 1138 963 <!-- CFC11 : variables available with key_cfc --> 964 <field id="qtrCFC11" long_name="Air-sea flux of CFC-11" unit="mol/m2/s" /> 965 <field id="qintCFC11" long_name="Cumulative air-sea flux of CFC-11" unit="mol/m2" /> 966 967 <!-- Bomb C14 : variables available with key_c14b --> 968 <field id="qtrC14b" long_name="Air-sea flux of Bomb C14" unit="mol/m2/s" /> 969 <field id="qintC14b" long_name="Cumulative air-sea flux of Bomb C14" unit="mol/m2" /> 970 <field id="fdecay" long_name="Radiactive decay of Bomb C14" unit="mol/m3" grid_ref="grid_T_3D" /> 1139 <!-- CFC11 : variables available with ln_cfc11 --> 1140 <field id="qtr_CFC11" long_name="Air-sea flux of CFC-11" unit="mol/m2/s" /> 1141 <field id="qint_CFC11" long_name="Cumulative air-sea flux of CFC-11" unit="mol/m2" /> 1142 1143 <!-- CFC12 : variables available with ln_cfc12 --> 1144 <field id="qtr_CFC12" long_name="Air-sea flux of CFC12" unit="mol/m2/s" /> 1145 <field id="qint_CFC12" long_name="Cumulative air-sea flux of CFC12" unit="mol/m2" /> 1146 1147 <!-- SF6 : variables available with ln_sf6 --> 1148 <field id="qtr_SF6" long_name="Air-sea flux of SF6" unit="mol/m2/s" /> 1149 <field id="qint_SF6" long_name="Cumulative air-sea flux of SF6" unit="mol/m2" /> 1150 1151 <!-- C14 : variables available with ln_c14 --> 1152 <field id="DeltaC14" long_name="Delta C14" unit="permil" grid_ref="grid_T_3D" /> 1153 <field id="C14Age" long_name="Radiocarbon age" unit="yr" grid_ref="grid_T_3D" /> 1154 <field id="RAge" long_name="Reservoir Age" unit="yr" /> 1155 <field id="qtr_C14" long_name="Air-sea flux of C14" unit="1/m2/s" /> 1156 <field id="qint_C14" long_name="Cumulative air-sea flux of C14" unit="1/m2" /> 971 1157 </field_group> 972 1158 973 <field_group id="PISCES_scalar" domain_ref="1point" > 974 <field id="pno3tot" long_name="global mean nitrate concentration" unit="mol/m3" /> 1159 <field_group id="tracer_scalar" domain_ref="1point" > 1160 <!-- PISCES scalar --> 1161 <field id="pno3tot" long_name="Global mean nitrate concentration" unit="mol/m3" /> 975 1162 <field id="ppo4tot" long_name="global mean phosphorus concentration" unit="mol/m3" /> 976 <field id="psiltot" long_name=" global mean silicate concentration" unit="mol/m3" />977 <field id="palktot" long_name=" global mean alkalinity concentration" unit="mol/m3" />978 <field id="pfertot" long_name=" global mean iron concentration" unit="mol/m3" />979 <field id="tcflx" long_name=" total Flux of Carbon out of the ocean" unit="mol/s" />980 <field id="tcflxcum" long_name=" cumulative total Flux of Carbon out of the ocean" unit="mol/s" />981 <field id="tcexp" long_name=" total Carbon export at 100m" unit="mol/s" />982 <field id="tintpp" long_name=" global total integrated primary production" unit="mol/s" />983 <field id="tnfix" long_name=" global total nitrogen fixation" unit="mol/s" />1163 <field id="psiltot" long_name="Global mean silicate concentration" unit="mol/m3" /> 1164 <field id="palktot" long_name="Global mean alkalinity concentration" unit="mol/m3" /> 1165 <field id="pfertot" long_name="Global mean iron concentration" unit="mol/m3" /> 1166 <field id="tcflx" long_name="Total Flux of Carbon out of the ocean" unit="mol/s" /> 1167 <field id="tcflxcum" long_name="Cumulative total Flux of Carbon out of the ocean" unit="mol/s" /> 1168 <field id="tcexp" long_name="Total Carbon export at 100m" unit="mol/s" /> 1169 <field id="tintpp" long_name="Global total integrated primary production" unit="mol/s" /> 1170 <field id="tnfix" long_name="Global total nitrogen fixation" unit="mol/s" /> 984 1171 <field id="tdenit" long_name="Total denitrification" unit="mol/s" /> 1172 <!-- C14 scalar --> 1173 <field id="AtmCO2" long_name="Global atmospheric CO2" unit="ppm" /> 1174 <field id="AtmC14" long_name="Global atmospheric DeltaC14" unit="permil" /> 1175 <field id="K_C14" long_name="Global 14C/C exchange velocity" unit="m/yr" /> 1176 <field id="K_CO2" long_name="Global CO2 piston velocity" unit="cm/h" /> 1177 <field id="C14Inv" long_name="global Radiocarbon ocean inventory" unit="10^26 atoms" /> 985 1178 </field_group> 986 1179 -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
r6945 r7403 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! PISCES (key_pisces) reference namelist (see below for key_pisces_reduced)2 !! PISCES reference namelist 3 3 !! 1 - air-sea exchange (nampisext) 4 4 !! 2 - biological parameters (nampisbio) … … 9 9 !! 7 - parameters for calcite chemistry (nampiscal) 10 10 !! 8 - parameters for inputs deposition (nampissed) 11 !! 9 - parameters for Kriest parameterization (nampiskrp, nampiskrs)12 !! 10 - additional 2D/3D diagnostics (nampisdia)13 11 !! 11 - Damping (nampisdmp) 14 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 15 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 12 !----------------------------------------------------------------------- 13 &nampismod ! Model used 14 !----------------------------------------------------------------------- 15 ln_p2z = .false. ! LOBSTER model used 16 ln_p4z = .true. ! PISCES model used 17 ln_p5z = .false. ! PISCES QUOTA model used 18 ln_ligand = .false. ! Enable organic ligands 19 / 20 !----------------------------------------------------------------------- 16 21 &nampisext ! air-sea exchange 17 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,22 !----------------------------------------------------------------------- 18 23 ln_co2int = .false. ! read atm pco2 from a file (T) or constant (F) 19 24 atcco2 = 280. ! Constant value atmospheric pCO2 - ln_co2int = F … … 23 28 ! ! then the first atmospheric CO2 record read is at years(1) 24 29 / 25 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''30 !----------------------------------------------------------------------- 26 31 &nampisatm ! Atmospheric prrssure 27 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,32 !----------------------------------------------------------------------- 28 33 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 29 34 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 30 35 sn_patm = 'presatm' , -1 , 'patm' , .true. , .true. , 'yearly' , '' , '' , '' 36 sn_atmco2 = 'presatmco2' , -1 , 'xco2' , .true. , .true. , 'yearly' , '' , '' , '' 31 37 cn_dir = './' ! root directory for the location of the dynamical files 32 38 ! 33 ln_presatm = .false. ! constant atmopsheric pressure (F) or from a file (T) 34 / 35 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 39 ln_presatm = .false. ! constant atmopsheric pressure (F) or from a file (T) 40 ln_presatmco2 = .false. ! Read spatialized atm co2 files [ppm] if TRUE 41 / 42 !----------------------------------------------------------------------- 36 43 &nampisbio ! biological parameters 37 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,44 !----------------------------------------------------------------------- 38 45 nrdttrc = 1 ! time step frequency for biology 39 46 wsbio = 2. ! POC sinking speed 40 47 xkmort = 2.E-7 ! half saturation constant for mortality 41 48 ferat3 = 10.E-6 ! Fe/C in zooplankton 42 wsbio2 = 30. ! Big particles sinking speed 49 wsbio2 = 50. ! Big particles sinking speed 50 wsbio2max = 50. ! Big particles maximum sinking speed 51 wsbio2scale= 5000. ! Big particles length scale of sinking 43 52 niter1max = 1 ! Maximum number of iterations for POC 44 niter2max = 1 ! Maximum number of iterations for GOC 45 / 46 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 47 &nampislim ! parameters for nutrient limitations 48 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 53 niter2max = 2 ! Maximum number of iterations for GOC 54 ! ! ln_ligand enabled 55 wfep = 0.2 ! FeP sinking speed 56 ldocp = 1.E-5 ! Phyto ligand production per unit doc 57 ldocz = 1.E-5 ! Zoo ligand production per unit doc 58 lthet = 0.5 ! Proportional loss of ligands due to Fe uptake 59 ! ! ln_p5z enabled 60 no3rat3 = 0.182 ! N/C ratio in zooplankton 61 po4rat3 = 0.0094 ! P/C ratio in zooplankton 62 / 63 !----------------------------------------------------------------------- 64 &namp4zlim ! parameters for nutrient limitations for PISCES std - ln_p4z 65 !----------------------------------------------------------------------- 49 66 concnno3 = 1.e-6 ! Nitrate half saturation of nanophytoplankton 50 67 concdno3 = 3.E-6 ! Nitrate half saturation for diatoms … … 66 83 qdfelim = 7.E-6 ! Optimal quota of diatoms 67 84 caco3r = 0.3 ! mean rain ratio 68 oxymin = 1.E-6 ! Half-saturation constant for anoxia 69 / 70 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 85 oxymin = 1.E-6 ! Half-saturation constant for anoxia 86 / 87 !----------------------------------------------------------------------- 88 &namp5zlim ! parameters for nutrient limitations PISCES QUOTA - ln_p5z 89 !----------------------------------------------------------------------- 90 concnno3 = 3e-6 ! Nitrate half saturation of nanophytoplankton 91 concpno3 = 1e-6 92 concdno3 = 4E-6 ! Phosphate half saturation for diatoms 93 concnnh4 = 1.5E-6 ! NH4 half saturation for phyto 94 concpnh4 = 4E-7 95 concdnh4 = 2E-6 ! NH4 half saturation for diatoms 96 concnpo4 = 3E-6 ! PO4 half saturation for phyto 97 concppo4 = 1.5E-6 98 concdpo4 = 4E-6 ! PO4 half saturation for diatoms 99 concnfer = 3E-9 ! Iron half saturation for phyto 100 concpfer = 1.5E-9 101 concdfer = 4E-9 ! Iron half saturation for diatoms 102 concbfe = 1.E-11 ! Half-saturation for Fe limitation of Bacteria 103 concbnh4 = 1.E-7 ! NH4 half saturation for phyto 104 concbno3 = 5.E-7 ! Phosphate half saturation for diatoms 105 concbpo4 = 1E-7 ! Phosphate half saturation for bacteria 106 xsizedia = 1.E-6 ! Minimum size criteria for diatoms 107 xsizephy = 1.E-6 ! Minimum size criteria for phyto 108 xsizepic = 1.E-6 109 xsizern = 1.0 ! Size ratio for nanophytoplankton 110 xsizerp = 1.0 111 xsizerd = 4.0 ! Size ratio for diatoms 112 xksi1 = 2.E-6 ! half saturation constant for Si uptake 113 xksi2 = 20E-6 ! half saturation constant for Si/C 114 xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization 115 caco3r = 0.35 ! mean rain ratio 116 oxymin = 1.E-6 ! Half-saturation constant for anoxia 117 / 118 !----------------------------------------------------------------------- 119 &namp5zquota ! parameters for nutrient limitations PISCES quota - ln_p5z 120 !----------------------------------------------------------------------- 121 qfnopt = 7.E-6 ! Optimal Fe quota of nanophyto 122 qfpopt = 7.E-6 ! Optimal Fe quota of picophyto 123 qfdopt = 7.E-6 ! Optimal quota of diatoms 124 qnnmin = 0.29 ! Minimal N quota for nano 125 qnnmax = 1.39 ! Maximal N quota for nano 126 qpnmin = 0.28 ! Minimal P quota for nano 127 qpnmax = 1.06 ! Maximal P quota for nano 128 qnpmin = 0.42 ! Minimal N quota for pico 129 qnpmax = 1.39 ! Maximal N quota for pico 130 qppmin = 0.25 ! Minimal P quota for pico 131 qppmax = 0.7 ! Maximal P quota for pico 132 qndmin = 0.25 ! Minimal N quota for diatoms 133 qndmax = 1.39 ! Maximal N quota for diatoms 134 qpdmin = 0.29 ! Minimal P quota for diatoms 135 qpdmax = 1.32 ! Maximal P quota for diatoms 136 qfnmax = 40E-6 ! Maximal Fe quota for nano 137 qfpmax = 40E-6 ! Maximal Fe quota for pico 138 qfdmax = 40E-6 ! Maximal Fe quota for diatoms 139 / 140 !----------------------------------------------------------------------- 71 141 &nampisopt ! parameters for optics 72 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,142 !----------------------------------------------------------------------- 73 143 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 74 144 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! … … 78 148 parlux = 0.43 ! Fraction of shortwave as PAR 79 149 / 80 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''81 &namp isprod ! parameters for phytoplankton growth82 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,83 pislope 84 pislope 2= 2. ! P-I slope for diatoms150 !----------------------------------------------------------------------- 151 &namp4zprod ! parameters for phytoplankton growth for PISCES std - ln_p4z 152 !----------------------------------------------------------------------- 153 pislopen = 2. ! P-I slope 154 pisloped = 2. ! P-I slope for diatoms 85 155 xadap = 0. ! Adaptation factor to low light 86 excret 87 excret 2= 0.05 ! excretion ratio of diatoms156 excretn = 0.05 ! excretion ratio of phytoplankton 157 excretd = 0.05 ! excretion ratio of diatoms 88 158 ln_newprod = .true. ! Enable new parame. of production (T/F) 89 159 bresp = 0.033 ! Basal respiration rate … … 95 165 grosip = 0.159 ! mean Si/C ratio 96 166 / 97 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 98 &nampismort ! parameters for phytoplankton sinks 99 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 100 wchl = 0.01 ! quadratic mortality of phytoplankton 167 !----------------------------------------------------------------------- 168 &namp5zprod ! parameters for phytoplankton growth for PISCES quota - ln_p5z 169 !----------------------------------------------------------------------- 170 pislopen = 3. ! P-I slope 171 pislopep = 3. ! P-I slope for picophytoplankton 172 pisloped = 3. ! P-I slope for diatoms 173 excretn = 0.05 ! excretion ratio of phytoplankton 174 excretp = 0.05 ! excretion ratio of picophytoplankton 175 excretd = 0.05 ! excretion ratio of diatoms 176 xadap = 0. ! Adaptation factor to low light 177 bresp = 0.02 ! Basal respiration rate 178 thetannm = 0.25 ! Maximum Chl/N in nanophytoplankton 179 thetanpm = 0.25 ! Maximum Chl/N in picophytoplankton 180 thetandm = 0.3 ! Maximum Chl/N in diatoms 181 chlcmin = 0.004 ! Minimum Chl/c in phytoplankton 182 grosip = 0.131 ! mean Si/C ratio 183 / 184 !----------------------------------------------------------------------- 185 &namp4zmort ! parameters for phytoplankton sinks for PISCES std - ln_p4z 186 !----------------------------------------------------------------------- 187 wchl = 0.01 ! quadratic mortality of phytoplankton 101 188 wchld = 0.01 ! maximum quadratic mortality of diatoms 102 189 wchldm = 0.03 ! maximum quadratic mortality of diatoms … … 104 191 mprat2 = 0.01 ! Diatoms mortality rate 105 192 / 106 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 107 &nampismes ! parameters for mesozooplankton 108 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 193 !----------------------------------------------------------------------- 194 &namp5zmort ! parameters for phytoplankton sinks for PISCES quota - ln_p5z 195 !----------------------------------------------------------------------- 196 wchln = 0.01 ! quadratic mortality of nanophytoplankton 197 wchlp = 0.01 ! quadratic mortality of picophytoplankton 198 wchld = 0.01 ! maximum quadratic mortality of diatoms 199 wchldm = 0.02 ! maximum quadratic mortality of diatoms 200 mpratn = 0.01 ! nanophytoplankton mortality rate 201 mpratp = 0.01 ! picophytoplankton mortality rate 202 mprat2 = 0.01 ! Diatoms mortality rate 203 / 204 !----------------------------------------------------------------------- 205 &namp4zmes ! parameters for mesozooplankton for PISCES std - ln_p4z 206 !----------------------------------------------------------------------- 109 207 part2 = 0.75 ! part of calcite not dissolved in mesozoo guts 110 208 grazrat2 = 0.75 ! maximal mesozoo grazing rate … … 126 224 grazflux = 2.e3 ! flux-feeding rate 127 225 / 128 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 129 &nampiszoo ! parameters for microzooplankton 130 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 131 part = 0.5 ! part of calcite not dissolved in microzoo gutsa 226 !----------------------------------------------------------------------- 227 &namp5zmes ! parameters for mesozooplankton 228 !----------------------------------------------------------------------- 229 part2 = 0.75 ! part of calcite not dissolved in mesozoo guts 230 grazrat2 = 0.85 ! maximal mesozoo grazing rate 231 bmetexc2 = .true. ! Metabolic use of excess carbon 232 resrat2 = 0.005 ! exsudation rate of mesozooplankton 233 mzrat2 = 0.02 ! mesozooplankton mortality rate 234 xpref2d = 1. ! zoo preference for phyto 235 xpref2p = 1. ! zoo preference for POC 236 xpref2z = 1. ! zoo preference for zoo 237 xpref2m = 0.2 ! meso preference for zoo 238 xpref2c = 0.3 ! zoo preference for poc 239 xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton 240 xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton 241 xthresh2phy = 1E-8 ! nanophyto feeding threshold for mesozooplankton 242 xthresh2mes = 1E-8 ! meso feeding threshold for mesozooplankton 243 xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton 244 xthresh2 = 3E-7 ! Food threshold for grazing 245 xkgraz2 = 20.E-6 ! half sturation constant for meso grazing 246 epsher2 = 0.5 ! Efficicency of Mesozoo growth 247 ssigma2 = 0.5 ! Fraction excreted as semi-labile DOM 248 srespir2 = 0.2 ! Active respiration 249 unass2c = 0.3 ! non assimilated fraction of P by mesozoo 250 unass2n = 0.3 ! non assimilated fraction of N by mesozoo 251 unass2p = 0.3 ! non assimilated fraction of P by mesozoo 252 grazflux = 3.e3 ! flux-feeding rate 253 / 254 !----------------------------------------------------------------------- 255 &namp4zzoo ! parameters for microzooplankton for PISCES std - ln_p4z 256 !----------------------------------------------------------------------- 257 part = 0.5 ! part of calcite not dissolved in microzoo guts 132 258 grazrat = 3.0 ! maximal zoo grazing rate 133 259 resrat = 0.03 ! exsudation rate of zooplankton … … 145 271 unass = 0.3 ! non assimilated fraction of phyto by zoo 146 272 / 147 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 273 !----------------------------------------------------------------------- 274 &namp5zzoo ! parameters for microzooplankton 275 !----------------------------------------------------------------------- 276 part = 0.5 ! part of calcite not dissolved in microzoo gutsa 277 grazrat = 2.75 ! maximal zoo grazing rate 278 bmetexc = .true. ! Metabolic use of excess carbon 279 resrat = 0.03 ! exsudation rate of zooplankton 280 mzrat = 0.005 ! zooplankton mortality rate 281 xprefc = 0.1 ! Microzoo preference for POM 282 xprefn = 1. ! Microzoo preference for Nanophyto 283 xprefp = 1.6 ! Microzoo preference for picophyto 284 xprefd = 1.0 ! Microzoo preference for Diatoms 285 xprefz = 0.3 ! Microzoo preference for microzooplankton 286 xthreshdia = 1.E-8 ! Diatoms feeding threshold for microzooplankton 287 xthreshphy = 1.E-8 ! Nanophyto feeding threshold for microzooplankton 288 xthreshpic = 1.E-8 289 xthreshzoo = 1.E-8 ! Nanophyto feeding threshold for microzooplankton 290 xthreshpoc = 1.E-8 ! POC feeding threshold for microzooplankton 291 xthresh = 3.E-7 ! Food threshold for feeding 292 xkgraz = 20.E-6 ! half sturation constant for grazing 293 epsher = 0.5 ! Efficiency of microzoo growth 294 ssigma = 0.5 ! Fraction excreted as semi-labile DOM 295 srespir = 0.2 ! Active respiration 296 unassc = 0.3 ! non assimilated fraction of C by zoo 297 unassn = 0.3 ! non assimilated fraction of C by zoo 298 unassp = 0.3 ! non assimilated fraction of C by zoo 299 / 300 !----------------------------------------------------------------------- 148 301 &nampisfer ! parameters for iron chemistry 149 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,302 !----------------------------------------------------------------------- 150 303 ln_fechem = .false. ! complex iron chemistry ( T/F ) 151 304 ln_ligvar = .false. ! variable ligand concentration 152 xlam1 = 0.005 ! scavenging rate of Iron 153 xlamdust = 150.0 ! Scavenging rate of dust 154 ligand = 0.6E-9 ! Ligands concentration 155 / 156 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 305 ln_fecolloid = .false. ! variable colloidal fraction 306 xlam1 = 0.005 ! scavenging rate of Iron 307 xlamdust = 150.0 ! Scavenging rate of dust 308 ligand = 0.6E-9 ! Ligands concentration 309 kfep = 0. ! Nanoparticle formation rate constant 310 / 311 !----------------------------------------------------------------------- 157 312 &nampisrem ! parameters for remineralization 158 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,313 !----------------------------------------------------------------------- 159 314 xremik = 0.3 ! remineralization rate of DOC 160 xremip = 0.025 ! remineralisation rate of POC161 315 nitrif = 0.05 ! NH4 nitrification rate 162 316 xsirem = 0.003 ! remineralization rate of Si 163 317 xsiremlab = 0.03 ! fast remineralization rate of Si 164 318 xsilab = 0.5 ! Fraction of labile biogenic silica 165 / 166 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 319 feratb = 10.E-6 ! Fe/C quota in bacteria 320 xkferb = 2.5E-10 ! Half-saturation constant for bacteria Fe/C 321 ! ! ln_p5z 322 xremikc = 0.25 ! remineralization rate of DOC 323 xremikn = 0.35 ! remineralization rate of DON 324 xremikp = 0.4 ! remineralization rate of DOP 325 ! feratb = 20E-6 ! Bacterial Fe/C ratio 326 ! xkferb = 3E-10 ! Half-saturation constant for bact. Fe/C 327 / 328 !----------------------------------------------------------------------- 329 &nampispoc ! parameters for organic particles 330 !----------------------------------------------------------------------- 331 xremip = 0.035 ! remineralisation rate of PON 332 jcpoc = 15 ! Number of lability classes 333 rshape = 1.0 ! Shape of the gamma function 334 ! ! ln_p5z 335 xremipc = 0.02 ! remineralisation rate of POC 336 xremipn = 0.025 ! remineralisation rate of PON 337 xremipp = 0.03 ! remineralisation rate of POP 338 / 339 !----------------------------------------------------------------------- 167 340 &nampiscal ! parameters for Calcite chemistry 168 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,341 !----------------------------------------------------------------------- 169 342 kdca = 6. ! calcite dissolution rate constant (1/time) 170 343 nca = 1. ! order of dissolution reaction (dimensionless) 171 344 / 172 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''345 !----------------------------------------------------------------------- 173 346 &nampissbc ! parameters for inputs deposition 174 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,347 !----------------------------------------------------------------------- 175 348 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 176 349 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! … … 205 378 concfediaz = 1.e-10 ! Diazotrophs half-saturation Cste for Iron 206 379 hratio = 1.e+7 ! Fe to 3He ratio assumed for vent iron supply 207 / 208 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 380 ! ! ln_ligand 381 fep_rats = 1. ! Fep/Fer ratio from sed sources 382 fep_rath = 1. ! Fep/Fer ratio from sed hydro sources 383 lgw_rath = 0.5 ! Weak ligand ratio from sed hydro sources 384 / 385 !----------------------------------------------------------------------- 386 &nampislig ! Namelist parameters for ligands, nampislig 387 !----------------------------------------------------------------------- 388 rfep = 0.001 ! Dissolution rate of FeP 389 rlgw = 1. ! Lifetime (years) of weak ligands 390 rlig = 1.E-4 ! Remin ligand production per unit C 391 prlgw = 1.E-4 ! Photolysis of weak ligand 392 rlgs = 1000. ! Lifetime (years) of strong ligands 393 / 394 !----------------------------------------------------------------------- 209 395 &nampisice ! Prescribed sea ice tracers 210 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,396 !----------------------------------------------------------------------- 211 397 ! constant ocean tracer concentrations are defined in trcice_pisces.F90 (Global, Arctic, Antarctic and Baltic) 212 398 ! trc_ice_ratio * betw 0 and 1: prescribed ice/ocean tracer concentration ratio … … 219 405 ! cn_trc_o * 'GL' use global ocean values making the Baltic distinction only 220 406 ! 'AA' use specific Arctic/Antarctic/Baltic values 221 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,407 !----------------------------------------------------------------------- 222 408 ! sn_tri_ ! trc_ice_ratio ! trc_ice_prescr ! cn_trc_o 223 409 sn_tri_dic = -1., -99., 'AA' … … 247 433 sn_tri_nh4 = 1., -99., 'AA' 248 434 / 249 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 250 &nampiskrp ! Kriest parameterization : parameters "key_kriest" 251 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 252 xkr_eta = 1.17 ! Sinking exponent 253 xkr_zeta = 2.28 ! N content exponent 254 xkr_ncontent = 5.7E-6 ! N content factor 255 xkr_mass_min = 0.0002 ! Minimum mass for Aggregates 256 xkr_mass_max = 1. ! Maximum mass for Aggregates 257 / 258 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 259 &nampiskrs ! Kriest parameterization : size classes "key_kriest" 260 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 261 xkr_sfact = 942. ! Sinking factor 262 xkr_stick = 0.5 ! Stickiness 263 xkr_nnano = 2.337 ! Nbr of cell in nano size class 264 xkr_ndiat = 3.718 ! Nbr of cell in diatoms size class 265 xkr_nmeso = 7.147 ! Nbr of cell in mesozoo size class 266 xkr_naggr = 9.877 ! Nbr of cell in aggregates size class 267 / 268 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 269 &nampisdia ! additional 2D/3D tracers diagnostics 270 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 271 ! ! name ! title of the field ! units ! 272 ! ! ! ! ! 273 pisdia2d(1) = 'Cflx ' , 'DIC flux ', 'molC/m2/s ' 274 pisdia2d(2) = 'Oflx ' , 'Oxygen flux ', 'molC/m2/s ' 275 pisdia2d(3) = 'Kg ' , 'Gas transfer ', 'mol/m2/s/uatm' 276 pisdia2d(4) = 'Delc ' , 'Delta CO2 ', 'uatm ' 277 pisdia2d(5) = 'PMO ' , 'POC export ', 'molC/m2/s ' 278 pisdia2d(6) = 'PMO2 ' , 'GOC export ', 'molC/m2/s ' 279 pisdia2d(7) = 'ExpFe1 ' , 'Nano iron export ', 'molFe/m2/s ' 280 pisdia2d(8) = 'ExpFe2 ' , 'Diatoms iron export ', 'molFe/m2/s ' 281 pisdia2d(9) = 'ExpSi ' , 'Silicate export ', 'molSi/m2/s ' 282 pisdia2d(10) = 'ExpCaCO3 ' , 'Calcite export ', 'molC/m2/s ' 283 pisdia2d(11) = 'heup ' , 'euphotic layer depth ', 'm ' 284 pisdia2d(12) = 'Fedep ' , 'Iron dep ', 'molFe/m2/s ' 285 pisdia2d(13) = 'Nfix ' , 'Nitrogen Fixation ', 'molN/m2/s ' 286 pisdia3d(1) = 'PH ' , 'PH ', '- ' 287 pisdia3d(2) = 'CO3 ' , 'Bicarbonates ', 'mol/l ' 288 pisdia3d(3) = 'CO3sat ' , 'CO3 saturation ', 'mol/l ' 289 pisdia3d(4) = 'PAR ' , 'light penetration ', 'W/m2 ' 290 pisdia3d(5) = 'PPPHY ' , 'Primary production of nanophyto ', 'molC/m3/s ' 291 pisdia3d(6) = 'PPPHY2 ' , 'Primary production of diatoms ', 'molC/m3/s ' 292 pisdia3d(7) = 'PPNEWN ' , 'New Primary production of nano ', 'molC/m3/s ' 293 pisdia3d(8) = 'PPNEWD ' , 'New Primary production of diat ', 'molC/m3/s ' 294 pisdia3d(9) = 'PBSi ' , 'Primary production of Si diatoms ', 'molSi/m3/s ' 295 pisdia3d(10) = 'PFeN ' , 'Primary production of nano iron ', 'molFe/m3/s ' 296 pisdia3d(11) = 'PFeD ' , 'Primary production of diatoms iron', 'molFe/m3/s ' 297 / 298 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 435 !----------------------------------------------------------------------- 299 436 &nampisdmp ! Damping 300 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,437 !----------------------------------------------------------------------- 301 438 ln_pisdmp = .true. ! Relaxation fo some tracers to a mean value 302 439 nn_pisdmp = 5475 ! Frequency of Relaxation 303 440 / 304 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''441 !----------------------------------------------------------------------- 305 442 &nampismass ! Mass conservation 306 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,443 !----------------------------------------------------------------------- 307 444 ln_check_mass = .false. ! Check mass conservation 308 445 / … … 317 454 !! 7 - general coefficients (namlobrat) 318 455 !! 8 - optical parameters (namlobopt) 319 320 !! 10 - biological diagnostics trends (namlobdbi)321 456 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 322 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''457 !----------------------------------------------------------------------- 323 458 &namlobphy ! biological parameters for phytoplankton 324 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,459 !----------------------------------------------------------------------- 325 460 tmumax = 1.21e-5 ! maximal phytoplankton growth rate [s-1] 326 461 rgamma = 0.05 ! phytoplankton exudation fraction [%] … … 329 464 aki = 33. ! light photosynthesis half saturation constant[W/m2] 330 465 / 331 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''466 !----------------------------------------------------------------------- 332 467 &namlobnut ! biological parameters for nutrients 333 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,468 !----------------------------------------------------------------------- 334 469 akno3 = 0.7 ! nitrate limitation half-saturation value [mmol/m3] 335 470 aknh4 = 0.001 ! ammonium limitation half-saturation value [mmol/m3] … … 337 472 psinut = 3. ! inhibition of nitrate uptake by ammonium 338 473 / 339 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''474 !----------------------------------------------------------------------- 340 475 &namlobzoo ! biological parameters for zooplankton 341 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,476 !----------------------------------------------------------------------- 342 477 rppz = 0.8 ! zooplankton nominal preference for phytoplancton food [%] 343 478 taus = 9.26E-6 ! specific zooplankton maximal grazing rate [s-1] … … 351 486 tmminz = 2.31e-6 ! minimal zooplankton mortality rate [(mmolN/m3)-1 d-1] 352 487 / 353 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''488 !----------------------------------------------------------------------- 354 489 &namlobdet ! biological parameters for detritus 355 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,490 !----------------------------------------------------------------------- 356 491 taudn = 5.80e-7 ! detritus breakdown rate [0.1/86400 s-1=10 days] 357 492 fdetlab = 0. ! NH4 fraction of detritus dissolution 358 493 / 359 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''494 !----------------------------------------------------------------------- 360 495 &namlobdom ! biological parameters for DOM 361 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,496 !----------------------------------------------------------------------- 362 497 taudomn = 6.43e-8 ! DOM breakdown rate [s-1] 363 498 ! ! slow remineralization rate of semi-labile dom to nh4 (1 month) 364 499 / 365 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''500 !----------------------------------------------------------------------- 366 501 &namlobsed ! parameters from aphotic layers to sediment 367 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,502 !----------------------------------------------------------------------- 368 503 sedlam = 3.86e-7 ! time coefficient of POC remineralization in sediments [s-1] 369 504 sedlostpoc = 0. ! mass of POC lost in sediments … … 371 506 xhr = -0.858 ! coeff for martin''s remineralisation profile 372 507 / 373 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''508 !----------------------------------------------------------------------- 374 509 &namlobrat ! general coefficients 375 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,510 !----------------------------------------------------------------------- 376 511 rcchl = 60. ! Carbone/Chlorophyl ratio [mgC.mgChla-1] 377 512 redf = 6.56 ! redfield ratio (C:N) for phyto 378 513 reddom = 6.56 ! redfield ratio (C:N) for DOM 379 514 / 380 ! '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''515 !----------------------------------------------------------------------- 381 516 &namlobopt ! optical parameters 382 ! ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,517 !----------------------------------------------------------------------- 383 518 xkg0 = 0.0232 ! green absorption coefficient of water 384 519 xkr0 = 0.225 ! red absorption coefficent of water … … 389 524 rpig = 0.7 ! chla/chla+pheo ratio 390 525 / 391 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''392 &nampisdbi ! biological diagnostics trends393 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,394 ! ! 2D bio diagnostics units : mmole/m2/s ("key_trdmld_trc")395 ! ! name ! title of the field ! units !396 pisdiabio(1) = 'NO3PHY' , 'Flux from NO3 to PHY ', 'mmole/m3/s'397 pisdiabio(2) = 'NH4PHY' , 'Flux from NH4 to PHY ', 'mmole/m3/s'398 pisdiabio(3) = 'PHYNH4' , 'Flux from PHY to NH4 ', 'mmole/m3/s'399 pisdiabio(4) = 'PHYDOM' , 'Flux from PHY to DOM ', 'mmole/m3/s'400 pisdiabio(5) = 'PHYZOO' , 'Flux from PHY to ZOO ', 'mmole/m3/s'401 pisdiabio(6) = 'PHYDET' , 'Flux from PHY to DET ', 'mmole/m3/s'402 pisdiabio(7) = 'DETZOO' , 'Flux from DET to ZOO ', 'mmole/m3/s'403 pisdiabio(8) = 'DETSED' , 'Flux from DET to SED ', 'mmole/m3/s'404 pisdiabio(9) = 'ZOODET' , 'Flux from ZOO to DET ', 'mmole/m3/s'405 pisdiabio(10) = 'ZOOBOD' , 'Zooplankton closure ', 'mmole/m3/s'406 pisdiabio(11) = 'ZOONH4' , 'Flux from ZOO to NH4 ', 'mmole/m3/s'407 pisdiabio(12) = 'ZOODOM' , 'Flux from ZOO to DOM ', 'mmole/m3/s'408 pisdiabio(13) = 'NH4NO3' , 'Flux from NH4 to NO3 ', 'mmole/m3/s'409 pisdiabio(14) = 'DOMNH4' , 'Flux from DOM to NH4 ', 'mmole/m3/s'410 pisdiabio(15) = 'DETNH4' , 'Flux from DET to NH4 ', 'mmole/m3/s'411 pisdiabio(16) = 'DETDOM' , 'Flux from DET to DOM ', 'mmole/m3/s'412 pisdiabio(17) = 'SEDNO3' , 'NO3 remineralization from SED', 'mmole/m3/s'413 / -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/SHARED/namelist_ref
r6497 r7403 288 288 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 289 289 ln_isf = .false. ! ice shelf (T => fill namsbc_isf) 290 ln_wave = .false. ! coupling with surface wave (T => fill namsbc_wave) 290 ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave) 291 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 292 ln_sdw = .false. ! Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 293 ln_tauoc = .false. ! Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 294 ln_stcor = .false. ! Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 291 295 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 292 296 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) … … 380 384 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 381 385 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 386 sn_snd_crtw = 'none' , 'no' , '' , '' , 'U,V' 387 sn_snd_ifrac = 'none' , 'no' , '' , '' , '' 388 sn_snd_wlev = 'coupled' , 'no' , '' , '' , '' 382 389 ! receive 383 390 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' … … 391 398 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 392 399 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 400 sn_rcv_hsig = 'none' , 'no' , '' , '' , '' 401 sn_rcv_iceflx = 'none' , 'no' , '' , '' , '' 402 sn_rcv_mslp = 'none' , 'no' , '' , '' , '' 403 sn_rcv_phioc = 'none' , 'no' , '' , '' , '' 404 sn_rcv_sdrfx = 'none' , 'no' , '' , '' , '' 405 sn_rcv_sdrfy = 'none' , 'no' , '' , '' , '' 406 sn_rcv_wper = 'none' , 'no' , '' , '' , '' 407 sn_rcv_wnum = 'none' , 'no' , '' , '' , '' 408 sn_rcv_wstrf = 'none' , 'no' , '' , '' , '' 409 sn_rcv_wdrag = 'none' , 'no' , '' , '' , '' 393 410 ! 394 411 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 535 552 / 536 553 !----------------------------------------------------------------------- 537 &namsbc_wave ! External fields from wave model (ln_wave=T) 538 !----------------------------------------------------------------------- 539 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 540 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 541 sn_cdg = 'cdg_wave', 1 , 'drag_coeff', .true. , .false., 'daily' , '' , '' , '' 542 sn_usd = 'sdw_wave', 1 , 'u_sd2d' , .true. , .false., 'daily' , '' , '' , '' 543 sn_vsd = 'sdw_wave', 1 , 'v_sd2d' , .true. , .false., 'daily' , '' , '' , '' 544 sn_wn = 'sdw_wave', 1 , 'wave_num' , .true. , .false., 'daily' , '' , '' , '' 545 ! 546 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 547 ln_cdgw = .false. ! Neutral drag coefficient read from wave model 548 ln_sdw = .false. ! Computation of 3D stokes drift 554 &namsbc_wave ! External fields from wave model 555 !----------------------------------------------------------------------- 556 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 557 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 558 sn_cdg = 'sdw_wave' , 1 , 'drag_coeff' , .true. , .false. , 'daily' , '' , '' , '' 559 sn_usd = 'sdw_wave' , 1 , 'u_sd2d' , .true. , .false. , 'daily' , '' , '' , '' 560 sn_vsd = 'sdw_wave' , 1 , 'v_sd2d' , .true. , .false. , 'daily' , '' , '' , '' 561 sn_swh = 'sdw_wave' , 1 , 'hs' , .true. , .false. , 'daily' , '' , '' , '' 562 sn_wmp = 'sdw_wave' , 1 , 'wmp' , .true. , .false. , 'daily' , '' , '' , '' 563 sn_wnum = 'sdw_wave' , 1 , 'wave_num' , .true. , .false. , 'daily' , '' , '' , '' 564 sn_tauoc = 'sdw_wave' , 1 , 'wave_stress', .true. , .false. , 'daily' , '' , '' , '' 565 ! 566 cn_dir = './' ! root directory for the location of drag coefficient files 549 567 / 550 568 !----------------------------------------------------------------------- … … 973 991 ln_zdfexp = .false. ! time-stepping: split-explicit (T) or implicit (F) time stepping 974 992 nn_zdfexp = 3 ! number of sub-timestep for ln_zdfexp=T 993 ln_zdfqiao = .false. ! Enhanced wave vertical mixing Qiao (2010) (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 975 994 / 976 995 !----------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/SHARED/namelist_top_ref
r6403 r7403 8 8 !! - tracer newtonian damping (namtrc_dmp) 9 9 !! - dynamical tracer trends (namtrc_trd) 10 !! - tracer output diagonstics (namtrc_dia)11 10 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 12 11 !----------------------------------------------------------------------- … … 14 13 !----------------------------------------------------------------------- 15 14 nn_dttrc = 1 ! time step frequency for passive sn_tracers 16 nn_writetrc = 5475 ! time step frequency for sn_tracer outputs17 15 ln_top_euler = .false. ! use Euler time-stepping for TOP 18 16 ln_rsttr = .false. ! start from a restart file (T) or not (F) … … 28 26 &namtrc ! tracers definition 29 27 !----------------------------------------------------------------------- 30 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 28 jp_bgc = 0 ! Number of passive tracers of the BGC model 29 ! 30 ln_pisces = .false. ! Run PISCES BGC model 31 ln_my_trc = .false. ! Run MY_TRC BGC model 32 ln_age = .false. ! Run the sea water age tracer 33 ln_cfc11 = .false. ! Run the CFC11 passive tracer 34 ln_cfc12 = .false. ! Run the CFC12 passive tracer 35 ln_sf6 = .false. ! Run the SF6 passive tracer 36 ln_c14 = .false. ! Run the Radiocarbon passive tracer 37 ! 38 ln_trcdta = .false. ! Initialisation from data input file (T) or not (F) 31 39 ln_trcdmp = .false. ! add a damping termn (T) or not (F) 32 40 ln_trcdmp_clo = .false. ! damping term (T) or not (F) on closed seas 41 ! 42 jp_dia3d = 0 ! Number of 3D diagnostic variables 43 jp_dia2d = 0 ! Number of 2D diagnostic variables 44 ! ! ! ! ! ! 45 ! ! name ! title of the field ! units ! initial data from file or not ! 46 ! sn_tracer(1) = 'tracer ' , 'Tracer Concentration ', ' - ' , .false. 47 / 48 !----------------------------------------------------------------------- 49 &namage ! AGE 50 !----------------------------------------------------------------------- 51 rn_age_depth = 10 ! depth over which age tracer reset to zero 52 rn_age_kill_rate = -0.000138888 ! = -1/7200 recip of relaxation timescale (s) for age tracer shallower than age_depth 33 53 / 34 54 !----------------------------------------------------------------------- … … 36 56 !----------------------------------------------------------------------- 37 57 cn_dir = './' ! root directory for the location of the data files 58 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 59 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 60 sn_trcdta(1) = 'data_TRC_nomask' , -12 , 'TRC' , .false. , .true. , 'yearly' , '' , '' , '' 38 61 / 39 62 !----------------------------------------------------------------------- … … 111 134 ln_trdtrc(23) = .true. 112 135 / 113 !-----------------------------------------------------------------------114 &namtrc_dia ! parameters for passive tracer additional diagnostics115 !----------------------------------------------------------------------116 ln_diatrc = .true. ! save additional diag. (T) or not (F)117 ln_diabio = .true. ! output biological trends118 nn_writedia = 5475 ! time step frequency for diagnostics119 nn_writebio = 10 ! frequency of biological outputs120 /121 136 !---------------------------------------------------------------------- 122 137 &namtrc_bc ! data for boundary conditions … … 125 140 cn_dir_cbc = './' ! root directory for the location of COASTAL data files 126 141 cn_dir_obc = './' ! root directory for the location of OPEN data files 142 ln_rnf_ctl = .false. ! Remove runoff dilution on tracers with absent river load 143 rn_bc_time = 86400. ! Time scaling factor for SBC and CBC data (seconds in a day) 127 144 / 128 145 !---------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/cfg.txt
r6403 r7403 11 11 GYRE OPA_SRC 12 12 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 13 ORCA2_LIM3_TRC OPA_SRC LIM_SRC_3 NST_SRC TOP_SRC -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6695 r7403 313 313 314 314 IF(lwp) THEN 315 WRITE(numout,*) ' ztests : ', ztests316 315 IF( ztests .NE. 4 )THEN 317 316 WRITE(numout,*) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6665 r7403 6 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 7 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 8 !!----------------------------------------------------------------------9 #if defined key_diaar510 !!----------------------------------------------------------------------11 !! 'key_diaar5' : activate ar5 diagnotics12 8 !!---------------------------------------------------------------------- 13 9 !! dia_ar5 : AR5 diagnostics … … 24 20 USE phycst ! physical constant 25 21 USE in_out_manager ! I/O manager 22 USE zdfddm 23 USE zdf_oce 26 24 27 25 IMPLICIT NONE … … 29 27 30 28 PUBLIC dia_ar5 ! routine called in step.F90 module 31 PUBLIC dia_ar5_init ! routine called in opa.F90 module32 29 PUBLIC dia_ar5_alloc ! routine called in nemogcm.F90 module 33 34 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE. ! coupled flag 30 PUBLIC dia_ar5_hst ! heat/salt transport 35 31 36 32 REAL(wp) :: vol0 ! ocean volume (interior domain) … … 39 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 40 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 37 38 LOGICAL :: l_ar5 41 39 40 !! * Substitutions 41 # include "zdfddm_substitute.h90" 42 # include "vectopt_loop_substitute.h90" 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 73 74 INTEGER :: ji, jj, jk ! dummy loop arguments 74 75 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 76 REAL(wp) :: zaw, zbw, zrw 75 77 ! 76 78 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace 77 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 78 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace … … 80 83 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 81 84 82 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres ) 83 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 84 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 85 86 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 87 88 ! ! total volume of liquid seawater 89 zvolssh = SUM( zarea_ssh(:,:) ) 90 IF( lk_mpp ) CALL mpp_sum( zvolssh ) 91 zvol = vol0 + zvolssh 85 IF( kt == nit000 ) CALL dia_ar5_init 86 87 IF( l_ar5 ) THEN 88 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres ) 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 92 ENDIF 93 ! 94 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 95 ! ! total volume of liquid seawater 96 zvolssh = SUM( zarea_ssh(:,:) ) 97 IF( lk_mpp ) CALL mpp_sum( zvolssh ) 98 zvol = vol0 + zvolssh 92 99 93 CALL iom_put( 'voltot', zvol ) 94 CALL iom_put( 'sshtot', zvolssh / area_tot ) 95 96 ! 97 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 98 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 99 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 100 ! 101 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 102 DO jk = 1, jpkm1 103 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 104 END DO 105 IF( ln_linssh ) THEN 106 IF( ln_isfcav ) THEN 107 DO ji=1,jpi 108 DO jj=1,jpj 109 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 110 END DO 111 END DO 112 ELSE 113 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 114 END IF 100 CALL iom_put( 'voltot', zvol ) 101 CALL iom_put( 'sshtot', zvolssh / area_tot ) 102 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 103 ! 104 ENDIF 105 106 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 107 ! 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 110 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 111 ! 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 113 DO jk = 1, jpkm1 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 116 IF( ln_linssh ) THEN 117 IF( ln_isfcav ) THEN 118 DO ji = 1, jpi 119 DO jj = 1, jpj 120 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 121 END DO 122 END DO 123 ELSE 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 125 END IF 115 126 !!gm 116 127 !!gm riceload should be added in both ln_linssh=T or F, no? 117 128 !!gm 118 END IF119 !120 zarho = SUM( area(:,:) * zbotpres(:,:) )121 IF( lk_mpp ) CALL mpp_sum( zarho )122 zssh_steric = - zarho / area_tot123 CALL iom_put( 'sshthster', zssh_steric )129 END IF 130 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 132 IF( lk_mpp ) CALL mpp_sum( zarho ) 133 zssh_steric = - zarho / area_tot 134 CALL iom_put( 'sshthster', zssh_steric ) 124 135 125 ! ! steric sea surface height 126 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 127 zrhop(:,:,jpk) = 0._wp 128 CALL iom_put( 'rhop', zrhop ) 129 ! 130 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 136 ! ! steric sea surface height 137 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 138 zrhop(:,:,jpk) = 0._wp 139 CALL iom_put( 'rhop', zrhop ) 140 ! 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 142 DO jk = 1, jpkm1 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 144 END DO 145 IF( ln_linssh ) THEN 146 IF ( ln_isfcav ) THEN 147 DO ji = 1,jpi 148 DO jj = 1,jpj 149 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 150 END DO 151 END DO 152 ELSE 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 154 END IF 155 END IF 156 ! 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 IF( lk_mpp ) CALL mpp_sum( zarho ) 159 zssh_steric = - zarho / area_tot 160 CALL iom_put( 'sshsteric', zssh_steric ) 161 162 ! ! ocean bottom pressure 163 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 165 CALL iom_put( 'botpres', zbotpres ) 166 ! 167 ENDIF 168 169 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 170 ! ! Mean density anomalie, temperature and salinity 171 ztemp = 0._wp 172 zsal = 0._wp 173 DO jk = 1, jpkm1 174 DO jj = 1, jpj 175 DO ji = 1, jpi 176 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 177 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 178 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) 179 END DO 180 END DO 181 END DO 182 IF( ln_linssh ) THEN 183 IF( ln_isfcav ) THEN 184 DO ji = 1, jpi 185 DO jj = 1, jpj 186 ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 187 zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 188 END DO 189 END DO 190 ELSE 191 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 192 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 193 END IF 194 ENDIF 195 IF( lk_mpp ) THEN 196 CALL mpp_sum( ztemp ) 197 CALL mpp_sum( zsal ) 198 END IF 199 ! 200 zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater 201 ztemp = ztemp / zvol ! potential temperature in liquid seawater 202 zsal = zsal / zvol ! Salinity of liquid seawater 203 ! 204 CALL iom_put( 'masstot', zmass ) 205 CALL iom_put( 'temptot', ztemp ) 206 CALL iom_put( 'saltot' , zsal ) 207 ! 208 ENDIF 209 210 IF( iom_use( 'tnpeo' )) THEN 211 ! Work done against stratification by vertical mixing 212 ! Exclude points where rn2 is negative as convection kicks in here and 213 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe ) 215 zpe(:,:) = 0._wp 216 IF( lk_zdfddm ) THEN 217 DO ji=1,jpi 218 DO jj=1,jpj 219 DO jk=1,jpk 220 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 221 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 222 ! 223 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 224 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 225 ! 226 zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 227 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 228 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 229 230 ENDDO 231 ENDDO 232 ENDDO 233 ELSE 234 DO ji = 1, jpi 235 DO jj = 1, jpj 236 DO jk = 1, jpk 237 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 238 ENDDO 239 ENDDO 240 ENDDO 241 ENDIF 242 CALL lbc_lnk( zpe, 'T', 1._wp) 243 CALL iom_put( 'tnpeo', zpe ) 244 CALL wrk_dealloc( jpi, jpj, zpe ) 245 ENDIF 246 ! 247 IF( l_ar5 ) THEN 248 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 249 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 250 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 251 ENDIF 252 ! 253 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') 254 ! 255 END SUBROUTINE dia_ar5 256 257 SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva ) 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE dia_ar5_htr *** 260 !!---------------------------------------------------------------------- 261 !! Wrapper for heat transport calculations 262 !! Called from all advection and/or diffusion routines 263 !!---------------------------------------------------------------------- 264 INTEGER , INTENT(in ) :: ktra ! tracer index 265 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 266 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pua ! 3D input array of advection/diffusion 267 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 268 ! 269 INTEGER :: ji, jj, jk 270 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 271 272 273 274 CALL wrk_alloc( jpi, jpj, z2d ) 275 z2d(:,:) = pua(:,:,1) 131 276 DO jk = 1, jpkm1 132 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 133 END DO 134 IF( ln_linssh ) THEN 135 IF ( ln_isfcav ) THEN 136 DO ji=1,jpi 137 DO jj=1,jpj 138 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 139 END DO 277 DO jj = 2, jpjm1 278 DO ji = fs_2, fs_jpim1 ! vector opt. 279 z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk) 140 280 END DO 141 ELSE 142 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 143 END IF 144 END IF 145 ! 146 zarho = SUM( area(:,:) * zbotpres(:,:) ) 147 IF( lk_mpp ) CALL mpp_sum( zarho ) 148 zssh_steric = - zarho / area_tot 149 CALL iom_put( 'sshsteric', zssh_steric ) 150 151 ! ! ocean bottom pressure 152 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 153 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 154 CALL iom_put( 'botpres', zbotpres ) 155 156 ! ! Mean density anomalie, temperature and salinity 157 ztemp = 0._wp 158 zsal = 0._wp 159 DO jk = 1, jpkm1 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 163 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 164 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) 165 END DO 166 END DO 167 END DO 168 IF( ln_linssh ) THEN 169 IF( ln_isfcav ) THEN 170 DO ji=1,jpi 171 DO jj=1,jpj 172 ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 173 zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 174 END DO 175 END DO 176 ELSE 177 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 178 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 179 END IF 180 ENDIF 181 IF( lk_mpp ) THEN 182 CALL mpp_sum( ztemp ) 183 CALL mpp_sum( zsal ) 184 END IF 185 ! 186 zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater 187 ztemp = ztemp / zvol ! potential temperature in liquid seawater 188 zsal = zsal / zvol ! Salinity of liquid seawater 189 ! 190 CALL iom_put( 'masstot', zmass ) 191 CALL iom_put( 'temptot', ztemp ) 192 CALL iom_put( 'saltot' , zsal ) 193 ! 194 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 195 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 196 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 197 ! 198 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') 199 ! 200 END SUBROUTINE dia_ar5 281 END DO 282 END DO 283 CALL lbc_lnk( z2d, 'U', -1. ) 284 IF( cptr == 'adv' ) THEN 285 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in i-direction 286 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0 * z2d ) ! advective salt transport in i-direction 287 ENDIF 288 IF( cptr == 'ldf' ) THEN 289 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 290 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0 * z2d ) ! diffusive salt transport in i-direction 291 ENDIF 292 ! 293 z2d(:,:) = pva(:,:,1) 294 DO jk = 1, jpkm1 295 DO jj = 2, jpjm1 296 DO ji = fs_2, fs_jpim1 ! vector opt. 297 z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk) 298 END DO 299 END DO 300 END DO 301 CALL lbc_lnk( z2d, 'V', -1. ) 302 IF( cptr == 'adv' ) THEN 303 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in j-direction 304 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0 * z2d ) ! advective salt transport in j-direction 305 ENDIF 306 IF( cptr == 'ldf' ) THEN 307 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 308 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0 * z2d ) ! diffusive salt transport in j-direction 309 ENDIF 310 311 CALL wrk_dealloc( jpi, jpj, z2d ) 312 313 END SUBROUTINE dia_ar5_hst 201 314 202 315 … … 217 330 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 218 331 ! 219 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 220 ! ! allocate dia_ar5 arrays 221 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 222 223 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 224 225 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 226 227 vol0 = 0._wp 228 thick0(:,:) = 0._wp 229 DO jk = 1, jpkm1 230 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 231 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 232 END DO 233 IF( lk_mpp ) CALL mpp_sum( vol0 ) 234 235 236 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 237 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 238 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 239 CALL iom_close( inum ) 240 241 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 242 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 243 IF( ln_zps ) THEN ! z-coord. partial steps 244 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 245 DO ji = 1, jpi 246 ik = mbkt(ji,jj) 247 IF( ik > 1 ) THEN 248 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 249 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 250 ENDIF 332 l_ar5 = .FALSE. 333 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 334 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 335 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) L_ar5 = .TRUE. 336 337 IF( l_ar5 ) THEN 338 ! 339 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 340 ! ! allocate dia_ar5 arrays 341 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 342 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 344 345 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 346 347 vol0 = 0._wp 348 thick0(:,:) = 0._wp 349 DO jk = 1, jpkm1 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 353 IF( lk_mpp ) CALL mpp_sum( vol0 ) 354 355 356 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 358 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 359 CALL iom_close( inum ) 360 361 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 362 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 363 IF( ln_zps ) THEN ! z-coord. partial steps 364 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 365 DO ji = 1, jpi 366 ik = mbkt(ji,jj) 367 IF( ik > 1 ) THEN 368 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 369 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 370 ENDIF 371 END DO 251 372 END DO 252 END DO 253 ENDIF 254 ! 255 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 373 ENDIF 374 ! 375 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 376 ! 377 ENDIF 256 378 ! 257 379 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') 258 380 ! 259 381 END SUBROUTINE dia_ar5_init 260 261 #else262 !!----------------------------------------------------------------------263 !! Default option : NO diaar5264 !!----------------------------------------------------------------------265 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE. ! coupled flag266 CONTAINS267 SUBROUTINE dia_ar5_init ! Dummy routine268 END SUBROUTINE dia_ar5_init269 SUBROUTINE dia_ar5( kt ) ! Empty routine270 INTEGER :: kt271 WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt272 END SUBROUTINE dia_ar5273 #endif274 382 275 383 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6140 r7403 9 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation 10 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 11 !! 3.6 ! 2016-06 (T. Graham) Addition of diagnostics for CMIP6 11 12 !!---------------------------------------------------------------------- 12 13 … … 38 39 PUBLIC dia_ptr_init ! call in step module 39 40 PUBLIC dia_ptr ! call in step module 41 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 40 42 41 43 ! !!** namelist namptr ** 42 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 44 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv !: Salt TRansports (adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_ove, str_ove !: heat Salt TRansports ( overturn.) 47 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_btr, str_btr !: heat Salt TRansports ( barotropic ) 45 48 46 49 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 50 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER 51 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 49 52 50 53 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 75 78 ! 76 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 77 REAL(wp) :: z v, zsfc ! local scalar80 REAL(wp) :: zsfc,zvfc ! local scalar 78 81 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 79 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 80 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 81 84 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 82 CHARACTER( len = 10 ) :: cl1 85 REAL(wp), DIMENSION(jpj) :: vsum ! 1D workspace 86 REAL(wp), DIMENSION(jpj,jpts) :: tssum ! 1D workspace 87 88 ! 89 !overturning calculation 90 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 91 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 93 94 95 CHARACTER( len = 12 ) :: cl1 83 96 !!---------------------------------------------------------------------- 84 97 ! … … 109 122 END DO 110 123 ENDIF 124 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 125 ! define fields multiplied by scalar 126 zmask(:,:,:) = 0._wp 127 zts(:,:,:,:) = 0._wp 128 zvn(:,:,:) = 0._wp 129 DO jk = 1, jpkm1 130 DO jj = 1, jpjm1 131 DO ji = 1, jpi 132 zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 133 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 134 zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc !Tracers averaged onto V grid 135 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 136 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc 137 ENDDO 138 ENDDO 139 ENDDO 140 ENDIF 141 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 142 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 143 r1_sjk(:,:,1) = 0._wp 144 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 145 146 ! i-mean T and S, j-Stream-Function, global 147 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 148 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 149 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 150 151 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 152 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 153 154 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 155 DO ji = 1, jpi 156 z2d(ji,:) = z2d(1,:) 157 ENDDO 158 cl1 = 'sophtove' 159 CALL iom_put( TRIM(cl1), z2d ) 160 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 161 DO ji = 1, jpi 162 z2d(ji,:) = z2d(1,:) 163 ENDDO 164 cl1 = 'sopstove' 165 CALL iom_put( TRIM(cl1), z2d ) 166 IF( ln_subbas ) THEN 167 DO jn = 2, nptr 168 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 169 r1_sjk(:,:,jn) = 0._wp 170 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 171 172 ! i-mean T and S, j-Stream-Function, basin 173 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 174 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 175 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 176 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 177 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 178 179 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 180 DO ji = 1, jpi 181 z2d(ji,:) = z2d(1,:) 182 ENDDO 183 cl1 = TRIM('sophtove_'//clsubb(jn)) 184 CALL iom_put( cl1, z2d ) 185 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 186 DO ji = 1, jpi 187 z2d(ji,:) = z2d(1,:) 188 ENDDO 189 cl1 = TRIM('sopstove_'//clsubb(jn)) 190 CALL iom_put( cl1, z2d ) 191 END DO 192 ENDIF 193 ENDIF 194 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 195 ! Calculate barotropic heat and salt transport here 196 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 197 r1_sjk(:,1,1) = 0._wp 198 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 199 200 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 201 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 202 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 203 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 204 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 205 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 206 DO ji = 2, jpi 207 z2d(ji,:) = z2d(1,:) 208 ENDDO 209 cl1 = 'sophtbtr' 210 CALL iom_put( TRIM(cl1), z2d ) 211 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 212 DO ji = 2, jpi 213 z2d(ji,:) = z2d(1,:) 214 ENDDO 215 cl1 = 'sopstbtr' 216 CALL iom_put( TRIM(cl1), z2d ) 217 IF( ln_subbas ) THEN 218 DO jn = 2, nptr 219 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 220 r1_sjk(:,1,jn) = 0._wp 221 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 222 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 223 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 224 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 225 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 226 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 227 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 228 DO ji = 1, jpi 229 z2d(ji,:) = z2d(1,:) 230 ENDDO 231 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 232 CALL iom_put( cl1, z2d ) 233 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 234 DO ji = 1, jpi 235 z2d(ji,:) = z2d(1,:) 236 ENDDO 237 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 238 CALL iom_put( cl1, z2d ) 239 ENDDO 240 ENDIF !ln_subbas 241 ENDIF !iom_use("sopstbtr....) 111 242 ! 112 243 ELSE … … 148 279 ! ! Advective and diffusive heat and salt transport 149 280 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 150 z2d(1,:) = htr_adv(: ) * rc_pwatt ! (conversion in PW)281 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 151 282 DO ji = 1, jpi 152 283 z2d(ji,:) = z2d(1,:) … … 154 285 cl1 = 'sophtadv' 155 286 CALL iom_put( TRIM(cl1), z2d ) 156 z2d(1,:) = str_adv(: ) * rc_ggram ! (conversion in Gg)287 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 157 288 DO ji = 1, jpi 158 289 z2d(ji,:) = z2d(1,:) … … 160 291 cl1 = 'sopstadv' 161 292 CALL iom_put( TRIM(cl1), z2d ) 293 IF( ln_subbas ) THEN 294 DO jn=2,nptr 295 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 296 DO ji = 1, jpi 297 z2d(ji,:) = z2d(1,:) 298 ENDDO 299 cl1 = TRIM('sophtadv_'//clsubb(jn)) 300 CALL iom_put( cl1, z2d ) 301 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 302 DO ji = 1, jpi 303 z2d(ji,:) = z2d(1,:) 304 ENDDO 305 cl1 = TRIM('sopstadv_'//clsubb(jn)) 306 CALL iom_put( cl1, z2d ) 307 ENDDO 308 ENDIF 162 309 ENDIF 163 310 ! 164 311 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 165 z2d(1,:) = htr_ldf(: ) * rc_pwatt ! (conversion in PW)312 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 166 313 DO ji = 1, jpi 167 314 z2d(ji,:) = z2d(1,:) … … 169 316 cl1 = 'sophtldf' 170 317 CALL iom_put( TRIM(cl1), z2d ) 171 z2d(1,:) = str_ldf(: ) * rc_ggram ! (conversion in Gg)318 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 172 319 DO ji = 1, jpi 173 320 z2d(ji,:) = z2d(1,:) … … 175 322 cl1 = 'sopstldf' 176 323 CALL iom_put( TRIM(cl1), z2d ) 324 IF( ln_subbas ) THEN 325 DO jn=2,nptr 326 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 327 DO ji = 1, jpi 328 z2d(ji,:) = z2d(1,:) 329 ENDDO 330 cl1 = TRIM('sophtldf_'//clsubb(jn)) 331 CALL iom_put( cl1, z2d ) 332 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 333 DO ji = 1, jpi 334 z2d(ji,:) = z2d(1,:) 335 ENDDO 336 cl1 = TRIM('sopstldf_'//clsubb(jn)) 337 CALL iom_put( cl1, z2d ) 338 ENDDO 339 ENDIF 340 ENDIF 341 342 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 343 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 344 DO ji = 1, jpi 345 z2d(ji,:) = z2d(1,:) 346 ENDDO 347 cl1 = 'sophteiv' 348 CALL iom_put( TRIM(cl1), z2d ) 349 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 350 DO ji = 1, jpi 351 z2d(ji,:) = z2d(1,:) 352 ENDDO 353 cl1 = 'sopsteiv' 354 CALL iom_put( TRIM(cl1), z2d ) 355 IF( ln_subbas ) THEN 356 DO jn=2,nptr 357 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 358 DO ji = 1, jpi 359 z2d(ji,:) = z2d(1,:) 360 ENDDO 361 cl1 = TRIM('sophteiv_'//clsubb(jn)) 362 CALL iom_put( cl1, z2d ) 363 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 364 DO ji = 1, jpi 365 z2d(ji,:) = z2d(1,:) 366 ENDDO 367 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 368 CALL iom_put( cl1, z2d ) 369 ENDDO 370 ENDIF 177 371 ENDIF 178 372 ! … … 254 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 255 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 256 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 257 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 258 455 ! 259 456 ENDIF … … 261 458 END SUBROUTINE dia_ptr_init 262 459 460 SUBROUTINE dia_ptr_hst( ktra, cptr, pva ) 461 !!---------------------------------------------------------------------- 462 !! *** ROUTINE dia_ptr_hst *** 463 !!---------------------------------------------------------------------- 464 !! Wrapper for heat and salt transport calculations to calculate them for each basin 465 !! Called from all advection and/or diffusion routines 466 !!---------------------------------------------------------------------- 467 INTEGER , INTENT(in ) :: ktra ! tracer index 468 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 469 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 470 INTEGER :: jn ! 471 472 IF( cptr == 'adv' ) THEN 473 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 474 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 475 ENDIF 476 IF( cptr == 'ldf' ) THEN 477 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 478 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 479 ENDIF 480 IF( cptr == 'eiv' ) THEN 481 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 482 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 483 ENDIF 484 ! 485 IF( ln_subbas ) THEN 486 ! 487 IF( cptr == 'adv' ) THEN 488 IF( ktra == jp_tem ) THEN 489 DO jn = 2, nptr 490 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 491 END DO 492 ENDIF 493 IF( ktra == jp_sal ) THEN 494 DO jn = 2, nptr 495 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 496 END DO 497 ENDIF 498 ENDIF 499 IF( cptr == 'ldf' ) THEN 500 IF( ktra == jp_tem ) THEN 501 DO jn = 2, nptr 502 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 503 END DO 504 ENDIF 505 IF( ktra == jp_sal ) THEN 506 DO jn = 2, nptr 507 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 508 END DO 509 ENDIF 510 ENDIF 511 IF( cptr == 'eiv' ) THEN 512 IF( ktra == jp_tem ) THEN 513 DO jn = 2, nptr 514 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 515 END DO 516 ENDIF 517 IF( ktra == jp_sal ) THEN 518 DO jn = 2, nptr 519 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 520 END DO 521 ENDIF 522 ENDIF 523 ! 524 ENDIF 525 END SUBROUTINE dia_ptr_hst 526 263 527 264 528 FUNCTION dia_ptr_alloc() … … 271 535 ierr(:) = 0 272 536 ! 273 ALLOCATE( btmsk(jpi,jpj,nptr) , & 274 & htr_adv(jpj) , str_adv(jpj) , & 275 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 537 ALLOCATE( btmsk(jpi,jpj,nptr) , & 538 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 539 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 540 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 541 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 542 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 276 543 ! 277 544 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6387 r7403 302 302 CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence 303 303 ! 304 IF( iom_use("u_masstr") .OR. iom_use("u_ heattr") .OR. iom_use("u_salttr") ) THEN304 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 305 305 z3d(:,:,jpk) = 0.e0 306 z2d(:,:) = 0.e0 306 307 DO jk = 1, jpkm1 307 308 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 309 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 308 310 END DO 309 311 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 312 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 310 313 ENDIF 311 314 … … 370 373 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 371 374 ENDIF 375 376 ! Vertical integral of temperature 377 IF( iom_use("tosmint") ) THEN 378 z2d(:,:)=0._wp 379 DO jk = 1, jpkm1 380 DO jj = 2, jpjm1 381 DO ji = fs_2, fs_jpim1 ! vector opt. 382 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 383 END DO 384 END DO 385 END DO 386 CALL lbc_lnk( z2d, 'T', -1. ) 387 CALL iom_put( "tosmint", z2d ) 388 ENDIF 389 390 ! Vertical integral of salinity 391 IF( iom_use("somint") ) THEN 392 z2d(:,:)=0._wp 393 DO jk = 1, jpkm1 394 DO jj = 2, jpjm1 395 DO ji = fs_2, fs_jpim1 ! vector opt. 396 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 397 END DO 398 END DO 399 END DO 400 CALL lbc_lnk( z2d, 'T', -1. ) 401 CALL iom_put( "somint", z2d ) 402 ENDIF 403 404 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 372 405 ! 373 406 CALL wrk_dealloc( jpi , jpj , z2d ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r6140 r7403 24 24 USE ldfslp ! lateral diffusion: slope of iso-neutral surfaces 25 25 USE ldfc1d_c2d ! lateral diffusion: 1D & 2D cases 26 USE dia ar5, ONLY: lk_diaar526 USE diaptr 27 27 ! 28 28 USE trc_oce, ONLY: lk_offline ! offline flag … … 730 730 CALL iom_put( "woce_eiv", zw3d ) 731 731 ! 732 ! 733 ! 734 CALL wrk_alloc( jpi,jpj, zw2d ) 735 ! 736 zztmp = 0.5_wp * rau0 * rcp 737 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 738 zw2d(:,:) = 0._wp 739 zw3d(:,:,:) = 0._wp 740 DO jk = 1, jpkm1 741 DO jj = 2, jpjm1 742 DO ji = fs_2, fs_jpim1 ! vector opt. 743 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 744 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 745 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 746 END DO 747 END DO 748 END DO 749 CALL lbc_lnk( zw2d, 'U', -1. ) 750 CALL lbc_lnk( zw3d, 'U', -1. ) 751 CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in i-direction 752 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction 753 ENDIF 754 zw2d(:,:) = 0._wp 755 zw3d(:,:,:) = 0._wp 756 DO jk = 1, jpkm1 757 DO jj = 2, jpjm1 758 DO ji = fs_2, fs_jpim1 ! vector opt. 759 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 760 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) ) 761 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 762 END DO 763 END DO 764 END DO 765 CALL lbc_lnk( zw2d, 'V', -1. ) 766 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction 767 CALL iom_put( "veiv_heattr", zztmp * zw3d ) ! heat transport in j-direction 768 ! 769 IF( ln_diaptr ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) 770 ! 771 zztmp = 0.5_wp * 0.5 772 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 773 zw2d(:,:) = 0._wp 774 zw3d(:,:,:) = 0._wp 775 DO jk = 1, jpkm1 776 DO jj = 2, jpjm1 777 DO ji = fs_2, fs_jpim1 ! vector opt. 778 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 779 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji+1,jj,jk,jp_sal) ) 780 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 781 END DO 782 END DO 783 END DO 784 CALL lbc_lnk( zw2d, 'U', -1. ) 785 CALL lbc_lnk( zw3d, 'U', -1. ) 786 CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in i-direction 787 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction 788 ENDIF 789 zw2d(:,:) = 0._wp 790 zw3d(:,:,:) = 0._wp 791 DO jk = 1, jpkm1 792 DO jj = 2, jpjm1 793 DO ji = fs_2, fs_jpim1 ! vector opt. 794 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 795 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji,jj+1,jk,jp_sal) ) 796 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 797 END DO 798 END DO 799 END DO 800 CALL lbc_lnk( zw2d, 'V', -1. ) 801 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction 802 CALL iom_put( "veiv_salttr", zztmp * zw3d ) ! salt transport in j-direction 803 ! 804 IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 805 ! 806 CALL wrk_dealloc( jpi,jpj, zw2d ) 732 807 CALL wrk_dealloc( jpi,jpj,jpk, zw3d ) 733 !734 !735 IF( lk_diaar5 ) THEN !== eiv heat transport: calculate and output ==!736 CALL wrk_alloc( jpi,jpj, zw2d )737 !738 zztmp = 0.5_wp * rau0 * rcp739 zw2d(:,:) = 0._wp740 DO jk = 1, jpkm1741 DO jj = 2, jpjm1742 DO ji = fs_2, fs_jpim1 ! vector opt.743 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) &744 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) )745 END DO746 END DO747 END DO748 CALL lbc_lnk( zw2d, 'U', -1. )749 CALL iom_put( "ueiv_heattr", zw2d ) ! heat transport in i-direction750 zw2d(:,:) = 0._wp751 DO jk = 1, jpkm1752 DO jj = 2, jpjm1753 DO ji = fs_2, fs_jpim1 ! vector opt.754 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) &755 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) )756 END DO757 END DO758 END DO759 CALL lbc_lnk( zw2d, 'V', -1. )760 CALL iom_put( "veiv_heattr", zw2d ) ! heat transport in i-direction761 !762 CALL wrk_dealloc( jpi,jpj, zw2d )763 ENDIF764 808 ! 765 809 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_dia') -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r5836 r7403 66 66 INTEGER :: nsnd ! total number of fields sent 67 67 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=5 0! Maximum number of coupling fields68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=55 ! Maximum number of coupling fields 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r6140 r7403 65 65 LOGICAL , PUBLIC :: ln_cdgw !: true if neutral drag coefficient from wave model 66 66 LOGICAL , PUBLIC :: ln_sdw !: true if 3d stokes drift from wave model 67 LOGICAL , PUBLIC :: ln_tauoc !: true if normalized stress from wave is used 68 LOGICAL , PUBLIC :: ln_stcor !: true if Stokes-Coriolis term is used 67 69 ! 68 70 LOGICAL , PUBLIC :: ln_icebergs !: Icebergs … … 120 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] 121 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) 122 #if defined key_cpl_carbon_cycle123 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 124 #endif125 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 126 126 … … 166 166 ! 167 167 ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & 168 #if defined key_cpl_carbon_cycle169 168 & atm_co2(jpi,jpj) , & 170 #endif171 169 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 172 170 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6813 r7403 745 745 746 746 !! Neutral coefficients at 10m: 747 IF( ln_ cdgw ) THEN ! wave drag case747 IF( ln_wave .AND. ln_cdgw ) THEN ! wave drag case 748 748 cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 749 749 ztmp0 (:,:) = cdn_wave(:,:) … … 791 791 END IF 792 792 793 IF( ln_ cdgw ) THEN ! surface wave case793 IF( ln_wave .AND. ln_cdgw ) THEN ! surface wave case 794 794 sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u ) 795 795 Cd = sqrt_Cd * sqrt_Cd -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r6140 r7403 17 17 USE fldread ! read input fields 18 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbcwave ,ONLY : cdn_wave !wave module20 19 ! 21 20 USE iom ! I/O manager library -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6722 r7403 18 18 !! sbc_cpl_snd : send fields to the atmosphere 19 19 !!---------------------------------------------------------------------- 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr ! Stochastic param. : ??? 24 USE sbcdcy ! surface boundary condition: diurnal cycle 25 USE phycst ! physical constants 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE trc_oce ! share SMS/Ocean variables 23 USE sbc_ice ! Surface boundary condition: ice fields 24 USE sbcapr ! Stochastic param. : ??? 25 USE sbcdcy ! surface boundary condition: diurnal cycle 26 USE sbcwave ! surface boundary condition: waves 27 USE phycst ! physical constants 26 28 #if defined key_lim3 27 29 USE ice ! ice variables … … 36 38 USE albedo ! 37 39 USE eosbn2 ! 38 USE sbcrnf , ONLY : l_rnfcpl 39 #if defined key_cpl_carbon_cycle 40 USE p4zflx, ONLY : oce_co2 41 #endif 40 USE sbcrnf, ONLY : l_rnfcpl 42 41 #if defined key_cice 43 42 USE ice_domain_size, only: ncat … … 106 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 107 INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure 108 INTEGER, PARAMETER :: jpr_hsig = 44 ! Hsig 109 INTEGER, PARAMETER :: jpr_phioc = 45 ! Wave=>ocean energy flux 110 INTEGER, PARAMETER :: jpr_sdrftx = 46 ! Stokes drift on grid 1 111 INTEGER, PARAMETER :: jpr_sdrfty = 47 ! Stokes drift on grid 2 112 INTEGER, PARAMETER :: jpr_wper = 48 ! Mean wave period 113 INTEGER, PARAMETER :: jpr_wnum = 49 ! Mean wavenumber 114 INTEGER, PARAMETER :: jpr_wstrf = 50 ! Stress fraction adsorbed by waves 115 INTEGER, PARAMETER :: jpr_wdrag = 51 ! Neutral surface drag coefficient 116 INTEGER, PARAMETER :: jprcv = 51 ! total number of fields received 109 117 110 118 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 136 144 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 137 145 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 138 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 146 INTEGER, PARAMETER :: jps_ficet = 29 ! total ice fraction 147 INTEGER, PARAMETER :: jps_ocxw = 30 ! currents on grid 1 148 INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2 149 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 150 INTEGER, PARAMETER :: jpsnd = 32 ! total number of fields sent 139 151 140 152 ! !!** namelist namsbc_cpl ** … … 150 162 ! ! Received from the atmosphere 151 163 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 152 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 164 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp 165 ! Send to waves 166 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 167 ! Received from waves 168 TYPE(FLD_C) :: sn_rcv_hsig,sn_rcv_phioc,sn_rcv_sdrfx,sn_rcv_sdrfy,sn_rcv_wper,sn_rcv_wnum,sn_rcv_wstrf,sn_rcv_wdrag 153 169 ! ! Other namelist parameters 154 170 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 163 179 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 164 180 165 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 181 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 182 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rau0) 183 184 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 166 185 167 186 !! Substitution … … 178 197 !! *** FUNCTION sbc_cpl_alloc *** 179 198 !!---------------------------------------------------------------------- 180 INTEGER :: ierr( 3)199 INTEGER :: ierr(4) 181 200 !!---------------------------------------------------------------------- 182 201 ierr(:) = 0 … … 189 208 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 190 209 ! 210 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 211 191 212 sbc_cpl_alloc = MAXVAL( ierr ) 192 213 IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc ) … … 214 235 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 215 236 !! 216 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 217 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 218 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 219 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 237 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 238 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 239 & sn_snd_ifrac, sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 240 & sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & 241 & sn_rcv_wdrag, sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 242 & sn_rcv_iceflx,sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp 220 243 !!--------------------------------------------------------------------- 221 244 ! … … 258 281 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 259 282 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 283 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' 284 WRITE(numout,*)' wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 285 WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 286 WRITE(numout,*)' Surface Stokes drift grid v = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 287 WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')' 288 WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')' 289 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 290 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 260 291 WRITE(numout,*)' sent fields (multiple ice categories)' 261 292 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 262 293 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 263 294 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 295 WRITE(numout,*)' total ice fraction = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 264 296 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 265 297 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref … … 267 299 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 268 300 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 301 WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')' 302 WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')' 303 WRITE(numout,*)' surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')' 304 WRITE(numout,*)' - referential = ', sn_snd_crtw%clvref 305 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 306 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 269 307 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 270 308 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask … … 305 343 ! 306 344 ! Vectors: change of sign at north fold ONLY if on the local grid 345 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 307 346 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 308 347 … … 372 411 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 373 412 ENDIF 374 ! 413 ENDIF 414 375 415 ! ! ------------------------- ! 376 416 ! ! freshwater budget ! E-P … … 467 507 ! ! Atmospheric CO2 ! 468 508 ! ! ------------------------- ! 469 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 509 srcv(jpr_co2 )%clname = 'O_AtmCO2' 510 IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) THEN 511 srcv(jpr_co2 )%laction = .TRUE. 512 l_co2cpl = .TRUE. 513 IF(lwp) WRITE(numout,*) 514 IF(lwp) WRITE(numout,*) ' Atmospheric pco2 received from oasis ' 515 IF(lwp) WRITE(numout,*) 516 ENDIF 517 518 ! ! ------------------------- ! 519 ! ! Mean Sea Level Pressure ! 520 ! ! ------------------------- ! 521 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 522 470 523 ! ! ------------------------- ! 471 524 ! ! topmelt and botmelt ! … … 481 534 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 482 535 ENDIF 536 ! ! ------------------------- ! 537 ! ! Wave breaking ! 538 ! ! ------------------------- ! 539 srcv(jpr_hsig)%clname = 'O_Hsigwa' ! significant wave height 540 IF( TRIM(sn_rcv_hsig%cldes ) == 'coupled' ) THEN 541 srcv(jpr_hsig)%laction = .TRUE. 542 cpl_hsig = .TRUE. 543 ENDIF 544 srcv(jpr_phioc)%clname = 'O_PhiOce' ! wave to ocean energy 545 IF( TRIM(sn_rcv_phioc%cldes ) == 'coupled' ) THEN 546 srcv(jpr_phioc)%laction = .TRUE. 547 cpl_phioc = .TRUE. 548 ENDIF 549 srcv(jpr_sdrftx)%clname = 'O_Sdrfx' ! Stokes drift in the u direction 550 IF( TRIM(sn_rcv_sdrfx%cldes ) == 'coupled' ) THEN 551 srcv(jpr_sdrftx)%laction = .TRUE. 552 cpl_sdrftx = .TRUE. 553 ENDIF 554 srcv(jpr_sdrfty)%clname = 'O_Sdrfy' ! Stokes drift in the v direction 555 IF( TRIM(sn_rcv_sdrfy%cldes ) == 'coupled' ) THEN 556 srcv(jpr_sdrfty)%laction = .TRUE. 557 cpl_sdrfty = .TRUE. 558 ENDIF 559 srcv(jpr_wper)%clname = 'O_WPer' ! mean wave period 560 IF( TRIM(sn_rcv_wper%cldes ) == 'coupled' ) THEN 561 srcv(jpr_wper)%laction = .TRUE. 562 cpl_wper = .TRUE. 563 ENDIF 564 srcv(jpr_wnum)%clname = 'O_WNum' ! mean wave number 565 IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' ) THEN 566 srcv(jpr_wnum)%laction = .TRUE. 567 cpl_wnum = .TRUE. 568 ENDIF 569 srcv(jpr_wstrf)%clname = 'O_WStrf' ! stress fraction adsorbed by the wave 570 IF( TRIM(sn_rcv_wstrf%cldes ) == 'coupled' ) THEN 571 srcv(jpr_wstrf)%laction = .TRUE. 572 cpl_wstrf = .TRUE. 573 ENDIF 574 srcv(jpr_wdrag)%clname = 'O_WDrag' ! neutral surface drag coefficient 575 IF( TRIM(sn_rcv_wdrag%cldes ) == 'coupled' ) THEN 576 srcv(jpr_wdrag)%laction = .TRUE. 577 cpl_wdrag = .TRUE. 578 ENDIF 579 ! 483 580 ! ! ------------------------------- ! 484 581 ! ! OPA-SAS coupling - rcv by opa ! … … 635 732 ! ! ------------------------- ! 636 733 ssnd(jps_fice)%clname = 'OIceFrc' 734 ssnd(jps_ficet)%clname = 'OIceFrcT' 637 735 ssnd(jps_hice)%clname = 'OIceTck' 638 736 ssnd(jps_hsnw)%clname = 'OSnwTck' … … 643 741 ENDIF 644 742 743 IF (TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 744 645 745 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 646 746 CASE( 'none' ) ! nothing to do … … 663 763 ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1' 664 764 ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1' 765 ssnd(jps_ocxw)%clname = 'O_OCurxw' 766 ssnd(jps_ocyw)%clname = 'O_OCuryw' 665 767 ! 666 768 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold … … 683 785 END SELECT 684 786 787 ssnd(jps_ocxw:jps_ocyw)%nsgn = -1. ! vectors: change of the sign at the north fold 788 789 IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 790 ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 791 ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 792 CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 793 ENDIF 794 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 795 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 796 CASE( 'none' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 797 CASE( 'oce only' ) ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 798 CASE( 'weighted oce and ice' ) ! nothing to do 799 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 800 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 801 END SELECT 802 685 803 ! ! ------------------------- ! 686 804 ! ! CO2 flux ! 687 805 ! ! ------------------------- ! 688 806 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 807 808 ! ! ------------------------- ! 809 ! ! Sea surface height ! 810 ! ! ------------------------- ! 811 ssnd(jps_wlev)%clname = 'O_Wlevel' ; IF( TRIM(sn_snd_wlev%cldes) == 'coupled' ) ssnd(jps_wlev)%laction = .TRUE. 689 812 690 813 ! ! ------------------------------- ! … … 781 904 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 782 905 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 783 ncpl_qsr_freq = 86400 / ncpl_qsr_freq906 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq 784 907 785 908 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) … … 835 958 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 836 959 !!---------------------------------------------------------------------- 837 INTEGER, INTENT(in) :: kt ! ocean model time step index 838 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 839 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 840 960 USE zdf_oce, ONLY : ln_zdfqiao 961 962 IMPLICIT NONE 963 964 INTEGER, INTENT(in) :: kt ! ocean model time step index 965 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 966 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 841 967 !! 842 968 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 984 1110 ENDIF 985 1111 986 #if defined key_cpl_carbon_cycle987 1112 ! ! ================== ! 988 1113 ! ! atmosph. CO2 (ppm) ! 989 1114 ! ! ================== ! 990 1115 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 991 #endif 1116 ! 1117 ! ! ========================= ! 1118 ! ! Mean Sea Level Pressure ! (taum) 1119 ! ! ========================= ! 1120 ! 1121 IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH 1122 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1123 1124 r1_grau = 1.e0 / (grav * rau0) !* constant for optimization 1125 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) 1126 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1127 1128 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1129 END IF 1130 ! 1131 IF( ln_sdw ) THEN ! Stokes Drift correction activated 1132 ! ! ========================= ! 1133 ! ! Stokes drift u ! 1134 ! ! ========================= ! 1135 IF( srcv(jpr_sdrftx)%laction ) zusd2dt(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 1136 ! 1137 ! ! ========================= ! 1138 ! ! Stokes drift v ! 1139 ! ! ========================= ! 1140 IF( srcv(jpr_sdrfty)%laction ) zvsd2dt(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 1141 ! 1142 ! ! ========================= ! 1143 ! ! Wave mean period ! 1144 ! ! ========================= ! 1145 IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 1146 ! 1147 ! ! ========================= ! 1148 ! ! Significant wave height ! 1149 ! ! ========================= ! 1150 IF( srcv(jpr_hsig)%laction ) swh(:,:) = frcv(jpr_hsig)%z3(:,:,1) 1151 ! 1152 ! ! ========================= ! 1153 ! ! Vertical mixing Qiao ! 1154 ! ! ========================= ! 1155 IF( srcv(jpr_wnum)%laction .AND. ln_zdfqiao ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 1156 1157 ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 1158 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1159 .OR. srcv(jpr_hsig)%laction ) THEN 1160 CALL sbc_stokes() 1161 IF( ln_zdfqiao .AND. .NOT. srcv(jpr_wnum)%laction ) CALL sbc_qiao() 1162 ENDIF 1163 IF( ln_zdfqiao .AND. srcv(jpr_wnum)%laction ) CALL sbc_qiao() 1164 ENDIF 1165 ! ! ========================= ! 1166 ! ! Stress adsorbed by waves ! 1167 ! ! ========================= ! 1168 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 1169 1170 ! ! ========================= ! 1171 ! ! Wave drag coefficient ! 1172 ! ! ========================= ! 1173 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 992 1174 993 1175 ! Fields received by SAS when OASIS coupling … … 1919 2101 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1920 2102 ENDIF 1921 !1922 #if defined key_cpl_carbon_cycle1923 2103 ! ! ------------------------- ! 1924 2104 ! ! CO2 flux from PISCES ! 1925 2105 ! ! ------------------------- ! 1926 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1927 ! 1928 #endif 2106 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2107 ! 1929 2108 ! ! ------------------------- ! 1930 2109 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! … … 2063 2242 ENDIF 2064 2243 ! 2244 ! ! ------------------------- ! 2245 ! ! Surface current to waves ! 2246 ! ! ------------------------- ! 2247 IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 2248 ! 2249 ! j+1 j -----V---F 2250 ! surface velocity always sent from T point ! | 2251 ! j | T U 2252 ! | | 2253 ! j j-1 -I-------| 2254 ! (for I) | | 2255 ! i-1 i i 2256 ! i i+1 (for I) 2257 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2258 CASE( 'oce only' ) ! C-grid ==> T 2259 DO jj = 2, jpjm1 2260 DO ji = fs_2, fs_jpim1 ! vector opt. 2261 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2262 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) ) 2263 END DO 2264 END DO 2265 CASE( 'weighted oce and ice' ) 2266 SELECT CASE ( cp_ice_msh ) 2267 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 2268 DO jj = 2, jpjm1 2269 DO ji = fs_2, fs_jpim1 ! vector opt. 2270 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2271 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2272 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2273 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2274 END DO 2275 END DO 2276 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 2277 DO jj = 2, jpjm1 2278 DO ji = 2, jpim1 ! NO vector opt. 2279 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 2280 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 2281 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 2282 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2283 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 2284 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2285 END DO 2286 END DO 2287 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2288 DO jj = 2, jpjm1 2289 DO ji = 2, jpim1 ! NO vector opt. 2290 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 2291 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 2292 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2293 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2294 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2295 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2296 END DO 2297 END DO 2298 END SELECT 2299 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 2300 CASE( 'mixed oce-ice' ) 2301 SELECT CASE ( cp_ice_msh ) 2302 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 2303 DO jj = 2, jpjm1 2304 DO ji = fs_2, fs_jpim1 ! vector opt. 2305 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2306 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2307 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2308 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2309 END DO 2310 END DO 2311 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 2312 DO jj = 2, jpjm1 2313 DO ji = 2, jpim1 ! NO vector opt. 2314 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2315 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 2316 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2317 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2318 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 2319 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2320 END DO 2321 END DO 2322 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2323 DO jj = 2, jpjm1 2324 DO ji = 2, jpim1 ! NO vector opt. 2325 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2326 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2327 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2328 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2329 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2330 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2331 END DO 2332 END DO 2333 END SELECT 2334 END SELECT 2335 CALL lbc_lnk( zotx1, ssnd(jps_ocxw)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 2336 ! 2337 ! 2338 IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2339 ! ! Ocean component 2340 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2341 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2342 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2343 zoty1(:,:) = ztmp2(:,:) 2344 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2345 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2346 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2347 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2348 zity1(:,:) = ztmp2(:,:) 2349 ENDIF 2350 ENDIF 2351 ! 2352 ! ! spherical coordinates to cartesian -> 2 components to 3 components 2353 ! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 2354 ! ztmp1(:,:) = zotx1(:,:) ! ocean currents 2355 ! ztmp2(:,:) = zoty1(:,:) 2356 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 2357 ! ! 2358 ! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities 2359 ! ztmp1(:,:) = zitx1(:,:) 2360 ! ztmp1(:,:) = zity1(:,:) 2361 ! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 2362 ! ENDIF 2363 ! ENDIF 2364 ! 2365 IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 2366 IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 2367 ! 2368 ENDIF 2369 ! 2370 IF( ssnd(jps_ficet)%laction ) THEN 2371 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2372 END IF 2373 ! ! ------------------------- ! 2374 ! ! Water levels to waves ! 2375 ! ! ------------------------- ! 2376 IF( ssnd(jps_wlev)%laction ) THEN 2377 IF( ln_apr_dyn ) THEN 2378 IF( kt /= nit000 ) THEN 2379 ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2380 ELSE 2381 ztmp1(:,:) = sshb(:,:) 2382 ENDIF 2383 ELSE 2384 ztmp1(:,:) = sshn(:,:) 2385 ENDIF 2386 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2387 END IF 2065 2388 ! 2066 2389 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r6140 r7403 90 90 INTEGER, INTENT( in ) :: kt ! ocean time step 91 91 ! 92 INTEGER :: ji, jj ! loop index 92 INTEGER :: ji, jj, jk ! loop index 93 INTEGER :: ikt, ikb ! loop index 93 94 REAL(wp), DIMENSION (:,:), POINTER :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 96 REAL(wp), DIMENSION(:,: ), POINTER :: zqhcisf2d 94 97 !!--------------------------------------------------------------------- 95 98 ! … … 161 164 CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) 162 165 CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.) 163 CALL lbc_lnk(fwfisf(:,:) ,'T',1.) 164 CALL lbc_lnk(qisf(:,:) ,'T',1.) 166 CALL lbc_lnk(fwfisf(:,:) ,'T',1.) 167 CALL lbc_lnk(qisf(:,:) ,'T',1.) 168 169 !============================================================================================================================================= 170 IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 171 CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 172 CALL wrk_alloc( jpi,jpj, zqhcisf2d ) 173 174 zfwfisf3d(:,:,:) = 0.0_wp ! 3d ice shelf melting (kg/m2/s) 175 zqhcisf3d(:,:,:) = 0.0_wp ! 3d heat content flux (W/m2) 176 zqlatisf3d(:,:,:)= 0.0_wp ! 3d ice shelf melting latent heat flux (W/m2) 177 zqhcisf2d(:,:) = fwfisf(:,:) * zt_frz * rcp ! 2d heat content flux (W/m2) 178 179 DO jj = 1,jpj 180 DO ji = 1,jpi 181 ikt = misfkt(ji,jj) 182 ikb = misfkb(ji,jj) 183 DO jk = ikt, ikb - 1 184 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 185 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 186 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 187 END DO 188 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk) 189 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk) 190 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk) 191 END DO 192 END DO 193 194 CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:)) 195 CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:)) 196 CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:)) 197 CALL iom_put('qhcisf' , zqhcisf2d (:,: )) 198 199 CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 200 CALL wrk_dealloc( jpi,jpj, zqhcisf2d ) 201 END IF 202 203 ! output 204 CALL iom_put('qlatisf' , qisf) 205 CALL iom_put('fwfisf', fwfisf) 206 !============================================================================================================================================= 165 207 166 208 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! … … 177 219 END IF 178 220 ! 179 ! output180 CALL iom_put('qisf' , qisf)181 CALL iom_put('fwfisf', fwfisf)182 183 221 ! deallocation 184 222 CALL wrk_dealloc( jpi,jpj, zt_frz, zdep ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6460 r7403 89 89 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs, & 90 90 & ln_cpl , ln_mixcpl, nn_components , nn_limflx , & 91 & ln_traqsr, ln_dm2dc , & 91 & ln_traqsr, ln_dm2dc , & 92 92 & nn_ice , nn_ice_embd, & 93 93 & ln_rnf , ln_ssr , ln_isf , nn_fwb , ln_apr_dyn, & 94 & ln_wave , 95 & nn_lsm 94 & ln_wave , ln_cdgw , ln_sdw , ln_tauoc , ln_stcor , & 95 & nn_lsm 96 96 INTEGER :: ios 97 97 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm … … 153 153 WRITE(numout,*) ' closed sea (=0/1) (set in namdom) nn_closea = ', nn_closea 154 154 WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm 155 WRITE(numout,*) ' surface wave ln_wave = ', ln_wave 155 WRITE(numout,*) ' surface wave ln_wave = ', ln_wave 156 WRITE(numout,*) ' Stokes drift corr. to vert. velocity ln_sdw = ', ln_sdw 157 WRITE(numout,*) ' wave modified ocean stress ln_tauoc = ', ln_tauoc 158 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor 159 WRITE(numout,*) ' neutral drag coefficient (CORE, MFS) ln_cdgw = ', ln_cdgw 156 160 ENDIF 157 161 ! … … 220 224 & CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 221 225 226 IF ( ln_wave ) THEN 227 !Activated wave module but neither drag nor stokes drift activated 228 IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) ) THEN 229 CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F') 230 !drag coefficient read from wave model definable only with mfs bulk formulae and core 231 ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) THEN 232 CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 233 ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN 234 CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 235 ENDIF 236 ELSE 237 IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) & 238 & CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ', & 239 & 'with drag coefficient (ln_cdgw =T) ' , & 240 & 'or Stokes Drift (ln_sdw=T) ' , & 241 & 'or ocean stress modification due to waves (ln_tauoc=T) ', & 242 & 'or Stokes-Coriolis term (ln_stcori=T)' ) 243 ENDIF 222 244 ! ! Choice of the Surface Boudary Condition (set nsbc) 223 245 ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl … … 357 379 & CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 358 380 END SELECT 359 381 IF ( ln_wave .AND. ln_tauoc) THEN ! Wave stress subctracted 382 utau(:,:) = utau(:,:)*tauoc_wave(:,:) 383 vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 384 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 385 ! 386 SELECT CASE( nsbc ) 387 CASE( 0,1,2,3,5,-1 ) ; 388 IF(lwp .AND. kt == nit000 ) WRITE(numout,*) 'WARNING: You are subtracting the wave stress to the ocean. & 389 & If not requested select ln_tauoc=.false' 390 END SELECT 391 ! 392 END IF 360 393 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 361 394 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r6140 r7403 4 4 !! Wave module 5 5 !!====================================================================== 6 !! History : 3.3 ! 2011-09 (Adani M) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (Adani M) Stokes Drift 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! sbc_wave : read drag coefficient from wave model in netcdf files 6 !! History : 3.3 ! 2011-09 (M. Adani) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (M. Adani) Stokes Drift 8 !! 3.6 ! 2014-09 (E. Clementi,P. Oddo) New Stokes Drift Computation 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! sbc_wave : wave data from wave model in netcdf files 12 13 !!---------------------------------------------------------------------- 13 14 USE oce ! 14 USE sbc_oce 15 USE sbc_oce ! Surface boundary condition: ocean fields 15 16 USE bdy_oce ! 16 17 USE domvvl ! 17 !18 18 USE iom ! I/O manager library 19 19 USE in_out_manager ! I/O manager 20 20 USE lib_mpp ! distribued memory computing library 21 USE fldread 21 USE fldread ! read input fields 22 22 USE wrk_nemo ! 23 USE phycst ! physical constants 23 24 24 25 IMPLICIT NONE 25 26 PRIVATE 26 27 27 PUBLIC sbc_wave ! routine called in sbc_blk_core or sbc_blk_mfs 28 PUBLIC sbc_stokes, sbc_qiao ! routines called in sbccpl 29 PUBLIC sbc_wave ! routine called in sbcmod 28 30 29 INTEGER , PARAMETER :: jpfld = 3 ! maximum number of files to read for srokes drift 30 INTEGER , PARAMETER :: jp_usd = 1 ! index of stokes drift (i-component) (m/s) at T-point 31 INTEGER , PARAMETER :: jp_vsd = 2 ! index of stokes drift (j-component) (m/s) at T-point 32 INTEGER , PARAMETER :: jp_wn = 3 ! index of wave number (1/m) at T-point 33 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 35 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 36 37 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: cdn_wave 38 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: usd3d, vsd3d, wsd3d 39 REAL(wp), ALLOCATABLE, DIMENSION (:,:) :: usd2d, vsd2d, uwavenum, vwavenum 31 ! Variables checking if the wave parameters are coupled (if not, they are read from file) 32 LOGICAL, PUBLIC :: cpl_hsig=.FALSE. 33 LOGICAL, PUBLIC :: cpl_phioc=.FALSE. 34 LOGICAL, PUBLIC :: cpl_sdrftx=.FALSE. 35 LOGICAL, PUBLIC :: cpl_sdrfty=.FALSE. 36 LOGICAL, PUBLIC :: cpl_wper=.FALSE. 37 LOGICAL, PUBLIC :: cpl_wnum=.FALSE. 38 LOGICAL, PUBLIC :: cpl_wstrf=.FALSE. 39 LOGICAL, PUBLIC :: cpl_wdrag=.FALSE. 40 41 INTEGER :: jpfld ! number of files to read for stokes drift 42 INTEGER :: jp_usd ! index of stokes drift (i-component) (m/s) at T-point 43 INTEGER :: jp_vsd ! index of stokes drift (j-component) (m/s) at T-point 44 INTEGER :: jp_swh ! index of significant wave hight (m) at T-point 45 INTEGER :: jp_wmp ! index of mean wave period (s) at T-point 46 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 48 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 49 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao 50 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 51 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave 52 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: swh,wmp, wnum 53 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave 54 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d 55 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: zusd2dt, zvsd2dt 56 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd3d, vsd3d, wsd3d 57 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd3dt, vsd3dt 40 58 41 59 !! * Substitutions … … 48 66 CONTAINS 49 67 68 SUBROUTINE sbc_stokes( ) 69 !!--------------------------------------------------------------------- 70 !! *** ROUTINE sbc_stokes *** 71 !! 72 !! ** Purpose : compute the 3d Stokes Drift according to Breivik et al., 73 !! 2014 (DOI: 10.1175/JPO-D-14-0020.1) 74 !! 75 !! ** Method : - Calculate Stokes transport speed 76 !! - Calculate horizontal divergence 77 !! - Integrate the horizontal divergenze from the bottom 78 !! ** action 79 !!--------------------------------------------------------------------- 80 INTEGER :: jj,ji,jk 81 REAL(wp) :: ztransp, zfac, zsp0, zk, zus, zvs 82 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3hdiv ! 3D workspace 83 !!--------------------------------------------------------------------- 84 ! 85 86 CALL wrk_alloc( jpi,jpj,jpk, ze3hdiv ) 87 DO jk = 1, jpk 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 ! On T grid 91 ! Stokes transport speed estimated from Hs and Tmean 92 ztransp = 2.0_wp*rpi*swh(ji,jj)**2.0_wp/(16.0_wp*MAX(wmp(ji,jj),0.0000001_wp)) 93 ! Stokes surface speed 94 zsp0 = SQRT( zusd2dt(ji,jj)**2 + zvsd2dt(ji,jj)**2) 95 ! Wavenumber scale 96 zk = ABS(zsp0)/MAX(ABS(5.97_wp*ztransp),0.0000001_wp) 97 ! Depth attenuation 98 zfac = EXP(-2.0_wp*zk*gdept_n(ji,jj,jk))/(1.0_wp+8.0_wp*zk*gdept_n(ji,jj,jk)) 99 ! 100 usd3dt(ji,jj,jk) = zfac * zusd2dt(ji,jj) * tmask(ji,jj,jk) 101 vsd3dt(ji,jj,jk) = zfac * zvsd2dt(ji,jj) * tmask(ji,jj,jk) 102 END DO 103 END DO 104 END DO 105 ! Into the U and V Grid 106 DO jk = 1, jpkm1 107 DO jj = 1, jpjm1 108 DO ji = 1, fs_jpim1 109 usd3d(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * & 110 & ( usd3dt(ji,jj,jk) + usd3dt(ji+1,jj,jk) ) 111 vsd3d(ji,jj,jk) = 0.5 * vmask(ji,jj,jk) * & 112 & ( vsd3dt(ji,jj,jk) + vsd3dt(ji,jj+1,jk) ) 113 END DO 114 END DO 115 END DO 116 ! 117 CALL lbc_lnk( usd3d(:,:,:), 'U', -1. ) 118 CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 119 ! 120 DO jk = 1, jpkm1 ! Horizontal divergence 121 DO jj = 2, jpj 122 DO ji = fs_2, jpi 123 ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * usd3d(ji ,jj,jk) & 124 & - e2u(ji-1,jj) * usd3d(ji-1,jj,jk) & 125 & + e1v(ji,jj ) * vsd3d(ji,jj ,jk) & 126 & - e1v(ji,jj-1) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj) 127 END DO 128 END DO 129 END DO 130 ! 131 IF( .NOT. AGRIF_Root() ) THEN 132 IF( nbondi == 1 .OR. nbondi == 2 ) ze3hdiv(nlci-1, : ,:) = 0._wp ! east 133 IF( nbondi == -1 .OR. nbondi == 2 ) ze3hdiv( 2 , : ,:) = 0._wp ! west 134 IF( nbondj == 1 .OR. nbondj == 2 ) ze3hdiv( : ,nlcj-1,:) = 0._wp ! north 135 IF( nbondj == -1 .OR. nbondj == 2 ) ze3hdiv( : , 2 ,:) = 0._wp ! south 136 ENDIF 137 ! 138 CALL lbc_lnk( ze3hdiv, 'T', 1. ) 139 ! 140 DO jk = jpkm1, 1, -1 ! integrate from the bottom the e3t * hor. divergence 141 wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - e3t_n(:,:,jk) * ze3hdiv(:,:,jk) 142 END DO 143 #if defined key_bdy 144 IF( lk_bdy ) THEN 145 DO jk = 1, jpkm1 146 wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:) 147 END DO 148 ENDIF 149 #endif 150 CALL wrk_dealloc( jpi,jpj,jpk, ze3hdiv ) 151 ! 152 END SUBROUTINE sbc_stokes 153 154 SUBROUTINE sbc_qiao 155 !!--------------------------------------------------------------------- 156 !! *** ROUTINE sbc_qiao *** 157 !! 158 !! ** Purpose : Qiao formulation for wave enhanced turbulence 159 !! 2010 (DOI: 10.1007/s10236-010-0326) 160 !! 161 !! ** Method : - 162 !! ** action 163 !!--------------------------------------------------------------------- 164 INTEGER :: jj, ji 165 166 ! Calculate the module of the stokes drift on T grid 167 !------------------------------------------------- 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 tsd2d(ji,jj) = SQRT( zusd2dt(ji,jj) * zusd2dt(ji,jj) + zvsd2dt(ji,jj) * zvsd2dt(ji,jj) ) 171 END DO 172 END DO 173 ! 174 END SUBROUTINE sbc_qiao 175 50 176 SUBROUTINE sbc_wave( kt ) 51 177 !!--------------------------------------------------------------------- 52 !! *** ROUTINE sbc_ apr***53 !! 54 !! ** Purpose : read drag coefficientfrom wave model in netcdf files.178 !! *** ROUTINE sbc_wave *** 179 !! 180 !! ** Purpose : read wave parameters from wave model in netcdf files. 55 181 !! 56 182 !! ** Method : - Read namelist namsbc_wave 57 183 !! - Read Cd_n10 fields in netcdf files 58 184 !! - Read stokes drift 2d in netcdf files 59 !! - Read wave number in netcdf files 60 !! - Compute 3d stokes drift using monochromatic 61 !! ** action : 62 !!--------------------------------------------------------------------- 63 INTEGER, INTENT( in ) :: kt ! ocean time step 185 !! - Read wave number in netcdf files 186 !! - Compute 3d stokes drift using Breivik et al.,2014 187 !! formulation 188 !! ** action 189 !!--------------------------------------------------------------------- 190 USE zdf_oce, ONLY : ln_zdfqiao 191 192 INTEGER, INTENT( in ) :: kt ! ocean time step 64 193 ! 65 194 INTEGER :: ierror ! return error code 66 INTEGER :: ifpr , jj,ji,jk67 INTEGER :: ios ! Local integer output status for namelist read68 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read195 INTEGER :: ifpr 196 INTEGER :: ios ! Local integer output status for namelist read 197 ! 69 198 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files 70 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, sn_wn ! informations about the fields to be read 71 REAL(wp), DIMENSION(:,:,:), POINTER :: zusd_t, zvsd_t, ze3hdiv ! 3D workspace 72 !! 73 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn, ln_cdgw , ln_sdw 199 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 200 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, & 201 & sn_swh, sn_wmp, sn_wnum, sn_tauoc ! informations about the fields to be read 202 !! 203 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_swh, sn_wmp, sn_wnum, sn_tauoc 74 204 !!--------------------------------------------------------------------- 75 205 ! … … 80 210 READ ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 81 211 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp ) 82 !212 83 213 REWIND( numnam_cfg ) ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model 84 214 READ ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) … … 86 216 IF(lwm) WRITE ( numond, namsbc_wave ) 87 217 ! 88 IF(lwp) THEN ! Control print89 WRITE(numout,*) ' Namelist namsbc_wave : surface wave setting'90 WRITE(numout,*) ' wave drag coefficient ln_cdgw = ', ln_cdgw91 WRITE(numout,*) ' wave stokes drift ln_sdw = ', ln_sdw92 ENDIF93 !94 IF( .NOT.( ln_cdgw .OR. ln_sdw ) ) &95 & CALL ctl_warn( 'ln_sbcwave=T but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )96 IF( ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) &97 & CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')98 !99 218 IF( ln_cdgw ) THEN 100 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 101 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 102 ! 103 ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) ) 104 IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 105 CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 219 IF( .NOT. cpl_wdrag ) THEN 220 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 221 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 222 ! 223 ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) ) 224 IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 225 CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 226 ENDIF 106 227 ALLOCATE( cdn_wave(jpi,jpj) ) 107 cdn_wave(:,:) = 0.0 108 ENDIF 228 ENDIF 229 230 IF( ln_tauoc ) THEN 231 IF( .NOT. cpl_wstrf ) THEN 232 ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc 233 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 234 ! 235 ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1) ) 236 IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) ) 237 CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 238 ENDIF 239 ALLOCATE( tauoc_wave(jpi,jpj) ) 240 ENDIF 241 109 242 IF( ln_sdw ) THEN 110 slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn 111 ALLOCATE( sf_sd(3), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 112 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 113 ! 114 DO ifpr= 1, jpfld 115 ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 116 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 117 END DO 118 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 119 ALLOCATE( usd2d(jpi,jpj) , vsd2d(jpi,jpj) , uwavenum(jpi,jpj) , vwavenum(jpi,jpj) ) 243 ! Find out how many fields have to be read from file if not coupled 244 jpfld=0 245 jp_usd=0; jp_vsd=0; jp_swh=0; jp_wmp=0 246 IF( .NOT. cpl_sdrftx ) THEN 247 jpfld=jpfld+1 248 jp_usd=jpfld 249 ENDIF 250 IF( .NOT. cpl_sdrfty ) THEN 251 jpfld=jpfld+1 252 jp_vsd=jpfld 253 ENDIF 254 IF( .NOT. cpl_hsig ) THEN 255 jpfld=jpfld+1 256 jp_swh=jpfld 257 ENDIF 258 IF( .NOT. cpl_wper ) THEN 259 jpfld=jpfld+1 260 jp_wmp=jpfld 261 ENDIF 262 263 ! Read from file only the non-coupled fields 264 IF( jpfld > 0 ) THEN 265 ALLOCATE( slf_i(jpfld) ) 266 IF( jp_usd > 0 ) slf_i(jp_usd) = sn_usd 267 IF( jp_vsd > 0 ) slf_i(jp_vsd) = sn_vsd 268 IF( jp_swh > 0 ) slf_i(jp_swh) = sn_swh 269 IF( jp_wmp > 0 ) slf_i(jp_wmp) = sn_wmp 270 ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift 271 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 272 ! 273 DO ifpr= 1, jpfld 274 ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 275 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 276 END DO 277 278 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 279 ENDIF 120 280 ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) ) 121 usd3d(:,:,:) = 0._wp ; usd2d(:,:) = 0._wp ; uwavenum(:,:) = 0._wp 122 vsd3d(:,:,:) = 0._wp ; vsd2d(:,:) = 0._wp ; vwavenum(:,:) = 0._wp 281 ALLOCATE( usd3dt(jpi,jpj,jpk),vsd3dt(jpi,jpj,jpk) ) 282 ALLOCATE( swh(jpi,jpj), wmp(jpi,jpj) ) 283 ALLOCATE( zusd2dt(jpi,jpj), zvsd2dt(jpi,jpj) ) 284 usd3d(:,:,:) = 0._wp 285 vsd3d(:,:,:) = 0._wp 123 286 wsd3d(:,:,:) = 0._wp 124 ENDIF 125 ENDIF 126 ! 127 IF( ln_cdgw ) THEN !== Neutral drag coefficient ==! 287 IF( ln_zdfqiao ) THEN !== Vertical mixing enhancement using Qiao,2010 ==! 288 IF( .NOT. cpl_wnum ) THEN 289 ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum 290 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable toallocate sf_wave structure' ) 291 ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) ) 292 IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 293 CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 294 ENDIF 295 ALLOCATE( wnum(jpi,jpj),tsd2d(jpi,jpj) ) 296 ENDIF 297 ENDIF 298 ENDIF 299 ! 300 IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN !== Neutral drag coefficient ==! 128 301 CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing 129 302 cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 130 303 ENDIF 131 ! 132 IF( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==! 304 305 IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN !== Wave induced stress ==! 306 CALL fld_read( kt, nn_fsbc, sf_tauoc ) !* read wave norm stress from external forcing 307 tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) 308 ENDIF 309 310 IF( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==! 133 311 ! 134 CALL wrk_alloc( jpi,jpj,jpk, zusd_t, zvsd_t, ze3hdiv ) 312 ! Read from file only if the field is not coupled 313 IF( jpfld > 0 ) THEN 314 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read wave parameters from external forcing 315 IF( jp_swh > 0 ) swh(:,:) = sf_sd(jp_swh)%fnow(:,:,1) ! significant wave height 316 IF( jp_wmp > 0 ) wmp(:,:) = sf_sd(jp_wmp)%fnow(:,:,1) ! wave mean period 317 IF( jp_usd > 0 ) zusd2dt(:,:) = sf_sd(jp_usd)%fnow(:,:,1) ! 2D zonal Stokes Drift at T point 318 IF( jp_vsd > 0 ) zvsd2dt(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) ! 2D meridional Stokes Drift at T point 319 ENDIF 135 320 ! 136 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read drag coefficient from external forcing 321 ! Read also wave number if needed, so that it is available in coupling routines 322 IF( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 323 CALL fld_read( kt, nn_fsbc, sf_wn ) !* read wave parameters from external forcing 324 wnum(:,:) = sf_wn(1)%fnow(:,:,1) 325 ENDIF 326 327 !== Computation of the 3d Stokes Drift according to Breivik et al.,2014 328 !(DOI: 10.1175/JPO-D-14-0020.1)==! 137 329 ! 138 DO jk = 1, jpkm1 !* distribute it on the vertical 139 zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 140 zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 141 END DO 142 DO jk = 1, jpkm1 !* interpolate the stokes drift from t-point to u- and v-points 143 DO jj = 1, jpjm1 144 DO ji = 1, jpim1 145 usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk) 146 vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk) 147 END DO 148 END DO 149 END DO 150 CALL lbc_lnk( usd3d(:,:,:), 'U', -1. ) 151 CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 152 ! 153 DO jk = 1, jpkm1 !* e3t * Horizontal divergence ==! 154 DO jj = 2, jpjm1 155 DO ji = fs_2, fs_jpim1 ! vector opt. 156 ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * usd3d(ji ,jj,jk) & 157 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk) & 158 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * vsd3d(ji,jj ,jk) & 159 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj) 160 END DO 161 END DO 162 IF( .NOT. AGRIF_Root() ) THEN 163 IF( nbondi == 1 .OR. nbondi == 2 ) ze3hdiv(nlci-1, : ,jk) = 0._wp ! east 164 IF( nbondi == -1 .OR. nbondi == 2 ) ze3hdiv( 2 , : ,jk) = 0._wp ! west 165 IF( nbondj == 1 .OR. nbondj == 2 ) ze3hdiv( : ,nlcj-1,jk) = 0._wp ! north 166 IF( nbondj == -1 .OR. nbondj == 2 ) ze3hdiv( : , 2 ,jk) = 0._wp ! south 167 ENDIF 168 END DO 169 CALL lbc_lnk( ze3hdiv, 'T', 1. ) 170 ! 171 DO jk = jpkm1, 1, -1 !* integrate from the bottom the e3t * hor. divergence 172 wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk) 173 END DO 174 #if defined key_bdy 175 IF( lk_bdy ) THEN 176 DO jk = 1, jpkm1 177 wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:) 178 END DO 179 ENDIF 180 #endif 181 CALL wrk_dealloc( jpi,jpj,jpk, zusd_t, zvsd_t, ze3hdiv ) 182 ! 330 ! Calculate only if no necessary fields are coupled, if not calculate later after coupling 331 IF( jpfld == 4 ) THEN 332 CALL sbc_stokes() 333 IF( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 334 CALL sbc_qiao() 335 ENDIF 336 ENDIF 183 337 ENDIF 184 338 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r6140 r7403 9 9 !! 3.7 ! 2014-05 (G. Madec) Add 2nd/4th order cases for CEN and FCT schemes 10 10 !! - ! 2014-12 (G. Madec) suppression of cross land advection option 11 !! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling 11 12 !!---------------------------------------------------------------------- 12 13 … … 26 27 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 27 28 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 29 USE trd_oce ! trends: ocean variables 30 USE trdtra ! trends manager: tracers 28 31 ! 29 32 USE in_out_manager ! I/O manager … … 33 36 USE wrk_nemo ! Memory Allocation 34 37 USE timing ! Timing 35 36 USE diaptr ! Poleward heat transport 38 USE sbcwave ! wave module 39 USE sbc_oce ! surface boundary condition: ocean 40 USE diaptr ! Poleward heat transport 37 41 38 42 IMPLICIT NONE … … 86 90 INTEGER :: jk ! dummy loop index 87 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 88 93 !!---------------------------------------------------------------------- 89 94 ! … … 93 98 ! 94 99 ! ! set time step 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 103 ! 95 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 96 105 r2dt = rdt ! = rdt (restarting with Euler time stepping) … … 100 109 ! 101 110 ! !== effective transport ==! 102 DO jk = 1, jpkm1 103 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 104 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 105 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 106 END DO 111 IF( ln_wave .AND. ln_sdw ) THEN 112 DO jk = 1, jpkm1 113 zun(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * & 114 & ( un(:,:,jk) + usd3d(:,:,jk) ) ! eulerian transport + Stokes Drift 115 zvn(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * & 116 & ( vn(:,:,jk) + vsd3d(:,:,jk) ) 117 zwn(:,:,jk) = e1e2t(:,:) * & 118 & ( wn(:,:,jk) + wsd3d(:,:,jk) ) 119 END DO 120 ELSE 121 DO jk = 1, jpkm1 122 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 123 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 124 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 125 END DO 126 ENDIF 107 127 ! 108 128 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections … … 127 147 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 128 148 !!gm ??? 149 ! 150 IF( l_trdtra ) THEN !* Save ta and sa trends 151 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 152 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 153 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 154 ENDIF 129 155 ! 130 156 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! … … 145 171 END SELECT 146 172 ! 147 ! ! print mean trends (used for debugging) 173 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 174 DO jk = 1, jpkm1 175 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 176 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 177 END DO 178 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 179 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 180 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 181 ENDIF 182 ! ! print mean trends (used for debugging) 148 183 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & 149 184 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r6140 r7403 18 18 USE trdtra ! trends manager: tracers 19 19 USE diaptr ! poleward transport diagnostics 20 USE diaar5 ! AR5 diagnostics 20 21 ! 21 22 USE in_out_manager ! I/O manager … … 32 33 33 34 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 35 36 LOGICAL :: l_trd ! flag to compute trends 37 LOGICAL :: l_ptr ! flag to compute poleward transport 38 LOGICAL :: l_hst ! flag to compute heat/salt transport 34 39 35 40 !! * Substitutions … … 88 93 ENDIF 89 94 ! 95 l_trd = .FALSE. 96 l_hst = .FALSE. 97 l_ptr = .FALSE. 98 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 99 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 100 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 101 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 102 ! 90 103 ! 91 104 zwz(:,:, 1 ) = 0._wp ! surface & bottom vertical flux set to zero for all tracers … … 184 197 END DO 185 198 ! ! trend diagnostics 186 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc )) THEN199 IF( l_trd ) THEN 187 200 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 188 201 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 189 202 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 190 203 END IF 191 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 192 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 193 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 194 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 195 ENDIF 204 ! ! "Poleward" heat and salt transports 205 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 206 ! ! heat and salt transport 207 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 196 208 ! 197 209 END DO -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r6771 r7403 20 20 USE trdtra ! tracers trends 21 21 USE diaptr ! poleward transport diagnostics 22 USE diaar5 ! AR5 diagnostics 23 USE phycst, ONLY: rau0_rcp 22 24 ! 23 25 USE in_out_manager ! I/O manager 26 USE iom 24 27 USE lib_mpp ! MPP library 25 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 36 39 37 40 LOGICAL :: l_trd ! flag to compute trends 41 LOGICAL :: l_ptr ! flag to compute poleward transport 42 LOGICAL :: l_hst ! flag to compute heat/salt transport 38 43 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 39 44 … … 80 85 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 81 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 83 89 !!---------------------------------------------------------------------- 84 90 ! … … 94 100 ! 95 101 l_trd = .FALSE. 96 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 97 ! 98 IF( l_trd ) THEN 102 l_hst = .FALSE. 103 l_ptr = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 106 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 107 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 108 ! 109 IF( l_trd .OR. l_hst ) THEN 99 110 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 100 111 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 101 112 ENDIF 102 113 ! 114 IF( l_ptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 117 ENDIF 103 118 ! ! surface & bottom value : flux set to zero one for all 104 119 zwz(:,:, 1 ) = 0._wp … … 161 176 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 162 177 ! 163 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)178 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 164 179 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 165 180 END IF 166 181 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 167 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 168 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 169 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 170 ENDIF 182 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 171 183 ! 172 184 ! !== anti-diffusive flux : high order minus low order ==! … … 292 304 END DO 293 305 ! 294 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)306 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 295 307 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 296 308 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 297 309 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 298 ! 310 ENDIF 311 ! 312 IF( l_trd ) THEN 299 313 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 300 314 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 301 315 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 302 316 ! 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz )304 317 END IF 305 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 306 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 307 IF( jn == jp_tem ) htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 308 IF( jn == jp_sal ) str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 318 ! ! heat/salt transport 319 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 320 321 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 322 IF( l_ptr ) THEN 323 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 324 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 309 325 ENDIF 310 326 ! 311 327 END DO ! end of tracer loop 312 328 ! 313 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 329 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 330 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 331 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 314 332 ! 315 333 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct') … … 357 375 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 358 376 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 377 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 359 378 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 360 379 !!---------------------------------------------------------------------- … … 373 392 ! 374 393 l_trd = .FALSE. 375 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 376 ! 377 IF( l_trd ) THEN 394 l_hst = .FALSE. 395 l_ptr = .FALSE. 396 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 397 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 398 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 399 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 400 ! 401 IF( l_trd .OR. l_hst ) THEN 378 402 CALL wrk_alloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 379 403 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 404 ENDIF 381 405 ! 406 IF( l_ptr ) THEN 407 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 408 zptry(:,:,:) = 0._wp 409 ENDIF 382 410 zwi(:,:,:) = 0._wp 383 411 z_rzts = 1._wp / REAL( kn_fct_zts, wp ) … … 445 473 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 446 474 ! 447 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)475 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 448 476 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 449 477 END IF 450 478 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 451 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 452 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 453 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 454 ENDIF 479 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 455 480 456 481 ! 3. anti-diffusive flux : high order minus low order … … 568 593 END DO 569 594 570 ! ! trend diagnostics (contribution of upstream fluxes)571 IF( l_trd ) THEN595 ! 596 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 572 597 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 573 598 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 574 599 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 575 ! 576 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 577 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 578 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 579 ! 580 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 600 ENDIF 601 ! 602 IF( l_trd ) THEN 603 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 604 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 605 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 606 ! 581 607 END IF 582 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 583 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 584 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 585 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 608 ! ! heat/salt transport 609 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 610 611 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 612 IF( l_ptr ) THEN 613 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 614 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 586 615 ENDIF 587 616 ! 588 617 END DO 589 618 ! 590 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 591 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 592 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 619 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 620 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 621 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 622 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 623 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 593 624 ! 594 625 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct_zts') -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r6140 r7403 23 23 USE sbcrnf ! river runoffs 24 24 USE diaptr ! poleward transport diagnostics 25 USE diaar5 ! AR5 diagnostics 26 25 27 ! 28 USE iom 26 29 USE wrk_nemo ! Memory Allocation 27 30 USE timing ! Timing … … 40 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index 41 44 45 LOGICAL :: l_trd ! flag to compute trends 46 LOGICAL :: l_ptr ! flag to compute poleward transport 47 LOGICAL :: l_hst ! flag to compute heat/salt transport 48 42 49 !! * Substitutions 43 50 # include "vectopt_loop_substitute.h90" … … 116 123 ENDIF 117 124 ! 125 l_trd = .FALSE. 126 l_hst = .FALSE. 127 l_ptr = .FALSE. 128 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 129 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 130 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 131 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 132 ! 118 133 DO jn = 1, kjpt !== loop over the tracers ==! 119 134 ! … … 192 207 END DO 193 208 ! ! trend diagnostics 194 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 195 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 209 IF( l_trd ) THEN 196 210 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 197 211 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 198 212 END IF 199 ! ! "Poleward" heat and salt transports 200 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 201 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 202 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 203 ENDIF 213 ! ! "Poleward" heat and salt transports 214 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 215 ! ! heat transport 216 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 204 217 ! 205 218 ! !* Vertical advective fluxes … … 262 275 END DO 263 276 ! ! send trends for diagnostic 264 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 265 &( cdtype == 'TRC' .AND. l_trdtrc ) ) & 266 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 277 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 267 278 ! 268 279 END DO ! end of tracer loop -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6140 r7403 34 34 PUBLIC tra_adv_qck ! routine called by step.F90 35 35 36 LOGICAL :: l_trd ! flag to compute trends37 36 REAL(wp) :: r1_6 = 1./ 6. ! 1/6 ratio 37 38 LOGICAL :: l_trd ! flag to compute trends 39 LOGICAL :: l_ptr ! flag to compute poleward transport 40 38 41 39 42 !! * Substitutions … … 103 106 ! 104 107 l_trd = .FALSE. 105 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 108 l_ptr = .FALSE. 109 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 110 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 111 ! 106 112 ! 107 113 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme … … 224 230 END DO 225 231 ! ! trend diagnostics 226 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )232 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 227 233 ! 228 234 END DO … … 347 353 END DO 348 354 ! ! trend diagnostics 349 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 350 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 351 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 352 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 353 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 354 ENDIF 357 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 355 358 ! 356 359 END DO -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6140 r7403 19 19 USE trdtra ! trends manager: tracers 20 20 USE diaptr ! poleward transport diagnostics 21 USE diaar5 ! AR5 diagnostics 22 21 23 ! 24 USE iom 22 25 USE lib_mpp ! I/O library 23 26 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 32 35 PUBLIC tra_adv_ubs ! routine called by traadv module 33 36 34 LOGICAL :: l_trd ! flag to compute trends or not 37 LOGICAL :: l_trd ! flag to compute trends 38 LOGICAL :: l_ptr ! flag to compute poleward transport 39 LOGICAL :: l_hst ! flag to compute heat transport 40 35 41 36 42 !! * Substitutions … … 109 115 ! 110 116 l_trd = .FALSE. 111 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 117 l_hst = .FALSE. 118 l_ptr = .FALSE. 119 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 120 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 121 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 122 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 112 123 ! 113 124 ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers … … 176 187 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 177 188 END IF 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 ENDIF 189 ! 190 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 191 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) ) 192 ! ! heati/salt transport 193 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) ) 194 ! 183 195 ! 184 196 ! !== vertical advective trend ==! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6140 r7403 24 24 USE ldfslp ! iso-neutral slopes 25 25 USE diaptr ! poleward transport diagnostics 26 USE diaar5 ! AR5 diagnostics 26 27 ! 27 28 USE in_out_manager ! I/O manager … … 36 37 37 38 PUBLIC tra_ldf_iso ! routine called by step.F90 39 40 LOGICAL :: l_ptr ! flag to compute poleward transport 41 LOGICAL :: l_hst ! flag to compute heat transport 38 42 39 43 !! * Substitutions … … 107 111 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 108 112 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 109 #if defined key_diaar5110 REAL(wp) :: zztmp ! local scalar111 #endif112 113 REAL(wp), POINTER, DIMENSION(:,:) :: zdkt, zdk1t, z2d 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw … … 127 128 ah_wslp2(:,:,:) = 0._wp 128 129 ENDIF 129 ! ! set time step size (Euler/Leapfrog) 130 ! 131 l_hst = .FALSE. 132 l_ptr = .FALSE. 133 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 134 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 135 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 136 ! 137 ! ! set time step size (Euler/Leapfrog) 130 138 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt ! at nit000 (Euler) 131 139 ELSE ; z2dt = 2.* rdt ! (Leapfrog) … … 369 377 ! 370 378 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 371 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 372 ! note sign is reversed to give down-gradient diffusive transports (#1043) 373 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 374 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 375 ENDIF 376 ! 377 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 378 ! 379 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 380 z2d(:,:) = zftu(ji,jj,1) 381 DO jk = 2, jpkm1 382 DO jj = 2, jpjm1 383 DO ji = fs_2, fs_jpim1 ! vector opt. 384 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 385 END DO 386 END DO 387 END DO 388 !!gm CAUTION I think there is an error of sign when using BLP operator.... 389 !!gm a multiplication by zsign is required (to be checked twice !) 390 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 391 CALL lbc_lnk( z2d, 'U', -1. ) 392 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 393 ! 394 z2d(:,:) = zftv(ji,jj,1) 395 DO jk = 2, jpkm1 396 DO jj = 2, jpjm1 397 DO ji = fs_2, fs_jpim1 ! vector opt. 398 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 399 END DO 400 END DO 401 END DO 402 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 403 CALL lbc_lnk( z2d, 'V', -1. ) 404 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 405 END IF 406 ! 407 ENDIF 379 ! note sign is reversed to give down-gradient diffusive transports ) 380 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:) ) 381 ! ! Diffusive heat transports 382 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 408 383 ! 409 384 ENDIF !== end pass selection ==! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
r6140 r7403 17 17 USE traldf_triad ! iso-neutral lateral diffusion (triad operator) (tra_ldf_triad routine) 18 18 USE diaptr ! poleward transport diagnostics 19 USE diaar5 ! AR5 diagnostics 19 20 USE trc_oce ! share passive tracers/Ocean variables 20 21 USE zpshde ! partial step: hor. derivative (zps_hde routine) … … 25 26 USE timing ! Timing 26 27 USE wrk_nemo ! Memory allocation 28 USE iom 27 29 28 30 IMPLICIT NONE … … 39 41 INTEGER, PARAMETER, PUBLIC :: np_lap_i = 11 , np_blp_i = 21 ! standard iso-neutral or geopotential operator 40 42 INTEGER, PARAMETER, PUBLIC :: np_lap_it = 12 , np_blp_it = 22 ! triad iso-neutral or geopotential operator 43 44 LOGICAL :: l_ptr ! flag to compute poleward transport 45 LOGICAL :: l_hst ! flag to compute heat transport 41 46 42 47 !! * Substitutions … … 95 100 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 96 101 ! 102 l_hst = .FALSE. 103 l_ptr = .FALSE. 104 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 105 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 106 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 107 ! 97 108 ! !== Initialization of metric arrays used for all tracers ==! 98 109 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 150 161 IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==! 151 162 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==! 152 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 153 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 154 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 155 ENDIF 163 164 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:) ) 165 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) ) 156 166 ENDIF 157 167 ! ! ================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r6140 r7403 20 20 USE traldf_iso ! lateral diffusion (Madec operator) (tra_ldf_iso routine) 21 21 USE diaptr ! poleward transport diagnostics 22 USE diaar5 ! AR5 diagnostics 22 23 USE zpshde ! partial step: hor. derivative (zps_hde routine) 23 24 ! … … 35 36 36 37 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels 38 39 LOGICAL :: l_ptr ! flag to compute poleward transport 40 LOGICAL :: l_hst ! flag to compute heat transport 41 37 42 38 43 !! * Substitutions … … 89 94 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 90 95 REAL(wp) :: zah, zah_slp, zaei_slp 91 #if defined key_diaar592 REAL(wp) :: zztmp ! local scalar93 #endif94 96 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d ! 2D workspace 95 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - … … 112 114 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 113 115 ENDIF 114 ! ! set time step size (Euler/Leapfrog) 116 ! 117 l_hst = .FALSE. 118 l_ptr = .FALSE. 119 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 120 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 121 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 122 ! 123 ! ! set time step size (Euler/Leapfrog) 115 124 IF( neuler == 0 .AND. kt == kit000 ) THEN ; z2dt = rdt ! at nit000 (Euler) 116 125 ELSE ; z2dt = 2.* rdt ! (Leapfrog) … … 416 425 ! 417 426 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 418 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 419 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 420 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 421 ENDIF 422 ! 423 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 424 ! 425 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 426 z2d(:,:) = zftu(ji,jj,1) 427 DO jk = 2, jpkm1 428 DO jj = 2, jpjm1 429 DO ji = fs_2, fs_jpim1 ! vector opt. 430 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 431 END DO 432 END DO 433 END DO 434 z2d(:,:) = rau0_rcp * z2d(:,:) 435 CALL lbc_lnk( z2d, 'U', -1. ) 436 CALL iom_put( "udiff_heattr", z2d ) ! heat i-transport 437 ! 438 z2d(:,:) = zftv(ji,jj,1) 439 DO jk = 2, jpkm1 440 DO jj = 2, jpjm1 441 DO ji = fs_2, fs_jpim1 ! vector opt. 442 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 443 END DO 444 END DO 445 END DO 446 z2d(:,:) = rau0_rcp * z2d(:,:) 447 CALL lbc_lnk( z2d, 'V', -1. ) 448 CALL iom_put( "vdiff_heattr", z2d ) ! heat j-transport 449 ENDIF 450 ! 451 ENDIF 427 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:) ) 428 ! ! Diffusive heat transports 429 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) ) 452 430 ! 453 431 ENDIF !== end pass selection ==! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r6140 r7403 33 33 # endif 34 34 ! !!!* Active tracers trends indexes 35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 14!: Total trend nb: change it when adding/removing one indice below35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 20 !: Total trend nb: change it when adding/removing one indice below 36 36 ! =============== ! 37 37 INTEGER, PUBLIC, PARAMETER :: jptra_xad = 1 !: x- horizontal advection … … 39 39 INTEGER, PUBLIC, PARAMETER :: jptra_zad = 3 !: z- vertical advection 40 40 INTEGER, PUBLIC, PARAMETER :: jptra_sad = 4 !: z- vertical advection 41 INTEGER, PUBLIC, PARAMETER :: jptra_ldf = 5 !: lateral diffusion 42 INTEGER, PUBLIC, PARAMETER :: jptra_zdf = 6 !: vertical diffusion 43 INTEGER, PUBLIC, PARAMETER :: jptra_zdfp = 7 !: "PURE" vert. diffusion (ln_traldf_iso=T) 44 INTEGER, PUBLIC, PARAMETER :: jptra_bbc = 8 !: Bottom Boundary Condition (geoth. heating) 45 INTEGER, PUBLIC, PARAMETER :: jptra_bbl = 9 !: Bottom Boundary Layer (diffusive and/or advective) 46 INTEGER, PUBLIC, PARAMETER :: jptra_npc = 10 !: non-penetrative convection treatment 47 INTEGER, PUBLIC, PARAMETER :: jptra_dmp = 11 !: internal restoring (damping) 48 INTEGER, PUBLIC, PARAMETER :: jptra_qsr = 12 !: penetrative solar radiation 49 INTEGER, PUBLIC, PARAMETER :: jptra_nsr = 13 !: non solar radiation / C/D on salinity (+runoff if ln_rnf=T) 50 INTEGER, PUBLIC, PARAMETER :: jptra_atf = 14 !: Asselin time filter 41 INTEGER, PUBLIC, PARAMETER :: jptra_totad = 5 !: total advection 42 INTEGER, PUBLIC, PARAMETER :: jptra_ldf = 6 !: lateral diffusion 43 INTEGER, PUBLIC, PARAMETER :: jptra_zdf = 7 !: vertical diffusion 44 INTEGER, PUBLIC, PARAMETER :: jptra_zdfp = 8 !: "PURE" vert. diffusion (ln_traldf_iso=T) 45 INTEGER, PUBLIC, PARAMETER :: jptra_evd = 9 !: EVD term (convection) 46 INTEGER, PUBLIC, PARAMETER :: jptra_bbc = 10 !: Bottom Boundary Condition (geoth. heating) 47 INTEGER, PUBLIC, PARAMETER :: jptra_bbl = 11 !: Bottom Boundary Layer (diffusive and/or advective) 48 INTEGER, PUBLIC, PARAMETER :: jptra_npc = 12 !: non-penetrative convection treatment 49 INTEGER, PUBLIC, PARAMETER :: jptra_dmp = 13 !: internal restoring (damping) 50 INTEGER, PUBLIC, PARAMETER :: jptra_qsr = 14 !: penetrative solar radiation 51 INTEGER, PUBLIC, PARAMETER :: jptra_nsr = 15 !: non solar radiation / C/D on salinity (+runoff if ln_rnf=T) 52 INTEGER, PUBLIC, PARAMETER :: jptra_atf = 16 !: Asselin time filter 53 INTEGER, PUBLIC, PARAMETER :: jptra_tot = 17 !: Model total trend 51 54 ! 52 55 ! !!!* Passive tracers trends indices (use if "key_top" defined) 53 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 1 5!: sources m. sinks54 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 1 6!: corr. trn<0 in trcrad55 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 17!: corr. trb<0 in trcrad (like atf)56 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 18 !: sources m. sinks 57 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 19 !: corr. trn<0 in trcrad 58 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 20 !: corr. trb<0 in trcrad (like atf) 56 59 ! 57 60 ! !!!* Momentum trends indices 58 INTEGER, PUBLIC, PARAMETER :: jptot_dyn = 1 5!: Total trend nb: change it when adding/removing one indice below61 INTEGER, PUBLIC, PARAMETER :: jptot_dyn = 13 !: Total trend nb: change it when adding/removing one indice below 59 62 ! =============== ! 60 63 INTEGER, PUBLIC, PARAMETER :: jpdyn_hpg = 1 !: hydrostatic pressure gradient -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
r6140 r7403 90 90 !!gm end 91 91 ! 92 IF( .NOT.ln_linssh .AND. ( l_trdtra .OR. l_trddyn ) ) CALL ctl_stop( 'trend diagnostics with variable volume not validated' )92 ! IF( .NOT.ln_linssh .AND. ( l_trdtra .OR. l_trddyn ) ) CALL ctl_stop( 'trend diagnostics with variable volume not validated' ) 93 93 94 94 !!gm : Potential BUG : 3D output only for vector invariant form! add a ctl_stop or code the flux form case -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r6140 r7403 28 28 USE lib_mpp ! MPP library 29 29 USE wrk_nemo ! Memory allocation 30 USE ldfslp ! Isopycnal slopes 30 31 31 32 IMPLICIT NONE … … 180 181 ! CALL iom_put( "ketrd_bfri", zke2d ) 181 182 ! ENDIF 182 CASE( jpdyn_ken ) ; ! kinetic energy 183 ! called in dynnxt.F90 before asselin time filter with putrd=ua and pvtrd=va 184 zke(:,:,:) = 0.5_wp * zke(:,:,:) 185 CALL iom_put( "KE", zke ) 186 ! 187 CALL ken_p2k( kt , zke ) 188 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 183 CASE( jpdyn_ken ) ; ! kinetic energy 184 ! called in dynnxt.F90 before asselin time filter 185 ! with putrd=ua and pvtrd=va 186 zke(:,:,:) = 0.5_wp * zke(:,:,:) 187 CALL iom_put( "KE", zke ) 188 ! 189 CALL ken_p2k( kt , zke ) 190 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 189 191 ! 190 192 END SELECT -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r6140 r7403 39 39 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_evd ! store avt_evd to calculate EVD trend 41 42 42 43 !! * Substitutions … … 54 55 !! *** FUNCTION trd_tra_alloc *** 55 56 !!--------------------------------------------------------------------- 56 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc )57 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc ) 57 58 ! 58 59 IF( lk_mpp ) CALL mpp_sum ( trd_tra_alloc ) … … 127 128 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 128 129 DO jk = 2, jpk 129 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zwt(:,:,jk) = avt_k(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 130 131 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 131 132 END DO … … 137 138 END DO 138 139 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) 140 ! 141 ! ! Also calculate EVD trend at this point. 142 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 143 DO jk = 2, jpk 144 zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 145 zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 146 END DO 147 ! 148 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 149 DO jk = 1, jpkm1 150 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 151 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 152 END DO 153 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 139 154 ! 140 155 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) … … 311 326 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 312 327 ENDIF 328 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx ) ! total advection 329 CALL iom_put( "strd_totad" , ptrdy ) 313 330 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 314 331 CALL iom_put( "strd_ldf" , ptrdy ) … … 317 334 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 318 335 CALL iom_put( "strd_zdfp", ptrdy ) 336 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd", ptrdx ) ! EVD trend (convection) 337 CALL iom_put( "strd_evd", ptrdy ) 319 338 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 320 339 CALL iom_put( "strd_dmp" , ptrdy ) … … 323 342 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 324 343 CALL iom_put( "strd_npc" , ptrdy ) 325 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx ) ! surface forcing + runoff (ln_rnf=T)326 CALL iom_put( "strd_cdt" , ptrdy )344 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 345 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 327 346 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 328 347 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 329 348 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 330 349 CALL iom_put( "strd_atf" , ptrdy ) 350 CASE( jptra_tot ) ; CALL iom_put( "ttrd_tot" , ptrdx ) ! model total trend 351 CALL iom_put( "strd_tot" , ptrdy ) 331 352 END SELECT 332 353 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r5836 r7403 35 35 INTEGER , PUBLIC :: nn_npc !: non penetrative convective scheme call frequency 36 36 INTEGER , PUBLIC :: nn_npcp !: non penetrative convective scheme print frequency 37 LOGICAL , PUBLIC :: ln_zdfqiao !: Enhanced wave vertical mixing Qiao(2010) formulation flag 37 38 38 39 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r6140 r7403 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE zdf_oce ! ocean vertical physics variables 19 USE trd_oce ! trends: ocean variables 20 USE trdtra ! trends manager: tracers 19 21 ! 20 22 USE in_out_manager ! I/O manager … … 111 113 zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:) ! change in avt due to evd 112 114 CALL iom_put( "avt_evd", zavt_evd ) ! output this change 115 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 113 116 ! 114 117 CALL wrk_dealloc( jpi,jpj,jpk, zavt_evd, zavm_evd ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r5836 r7403 51 51 INTEGER :: ioptio, ios ! local integers 52 52 !! 53 NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp, & 54 & ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp 53 NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp, & 54 & ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp, & 55 & ln_zdfqiao 55 56 !!---------------------------------------------------------------------- 56 57 … … 81 82 WRITE(numout,*) ' npc call frequency nn_npc = ', nn_npc 82 83 WRITE(numout,*) ' npc print frequency nn_npcp = ', nn_npcp 84 WRITE(numout,*) ' Qiao formulation flag ln_zdfqiao=', ln_zdfqiao 83 85 ENDIF 84 86 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r7048 r7403 205 205 DO jj = 2, jpjm1 206 206 DO ji = fs_2, fs_jpim1 207 IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN207 IF( gdepw_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 208 208 avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 209 209 avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6152 r7403 490 490 IF( lk_floats ) CALL flo_init ! drifting Floats 491 491 CALL dia_cfl_init ! Initialise CFL diagnostics 492 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag493 492 CALL dia_ptr_init ! Poleward TRansports initialization 494 493 IF( lk_diadct ) CALL dia_dct_init ! Sections tranports -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/step.F90
r6464 r7403 26 26 !! 3.6 ! 2012-07 (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 27 27 !! 3.6 ! 2014-04 (F. Roquet, G. Madec) New equations of state 28 !! 3.6 ! 2014-10 (E. Clementi, P. Oddo) Add Qiao vertical mixing in case of waves 28 29 !! 3.7 ! 2014-10 (G. Madec) LDF simplication 29 30 !! - ! 2014-12 (G. Madec) remove KPP scheme … … 73 74 !! -8- Outputs and diagnostics 74 75 !!---------------------------------------------------------------------- 75 INTEGER :: j k! dummy loop indice76 INTEGER :: ji,jj,jk ! dummy loop indice 76 77 INTEGER :: indic ! error indicator if < 0 77 78 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) … … 128 129 CALL zdf_bfr( kstp ) ! bottom friction (if quadratic) 129 130 ! ! Vertical eddy viscosity and diffusivity coefficients 130 IF( lk_zdfric ) CALL zdf_ric( kstp ) ! Richardson number dependent Kz 131 IF( lk_zdftke ) CALL zdf_tke( kstp ) ! TKE closure scheme for Kz 132 IF( lk_zdfgls ) CALL zdf_gls( kstp ) ! GLS closure scheme for Kz 133 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) 131 IF( lk_zdfric ) CALL zdf_ric ( kstp ) ! Richardson number dependent Kz 132 IF( lk_zdftke ) CALL zdf_tke ( kstp ) ! TKE closure scheme for Kz 133 IF( lk_zdfgls ) CALL zdf_gls ( kstp ) ! GLS closure scheme for Kz 134 IF( ln_zdfqiao ) CALL zdf_qiao( kstp ) ! Qiao vertical mixing 135 ! 136 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) 134 137 avt (:,:,:) = rn_avt0 * wmask (:,:,:) 135 138 avmu(:,:,:) = rn_avm0 * wumask(:,:,:) … … 207 210 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 208 211 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 212 IF( ln_wave .AND. ln_sdw .AND. ln_stcor) & 213 & CALL dyn_stcor ( kstp ) ! Stokes-Coriolis forcing 209 214 CALL dyn_ldf ( kstp ) ! lateral mixing 210 215 CALL dyn_hpg ( kstp ) ! horizontal gradient of Hydrostatic pressure … … 234 239 IF(.NOT.ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 235 240 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 236 IF( lk_diaar5 )CALL dia_ar5( kstp ) ! ar5 diag241 CALL dia_ar5( kstp ) ! ar5 diag 237 242 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 238 243 CALL dia_wri( kstp ) ! ocean model: outputs -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r6140 r7403 19 19 USE sbcapr ! surface boundary condition: atmospheric pressure 20 20 USE sbctide ! Tide initialisation 21 USE sbcwave ! Wave intialisation 21 22 22 23 USE traqsr ! solar radiation penetration (tra_qsr routine) … … 41 42 USE dynzdf ! vertical diffusion (dyn_zdf routine) 42 43 USE dynspg ! surface pressure gradient (dyn_spg routine) 44 USE dynstcor ! simp. form of Stokes-Coriolis 43 45 44 46 USE dynnxt ! time-stepping (dyn_nxt routine) … … 71 73 USE zdfric ! Richardson vertical mixing (zdf_ric routine) 72 74 USE zdfmxl ! Mixed-layer depth (zdf_mxl routine) 75 USE zdfqiao !Qiao module wave induced mixing (zdf_qiao routine) 73 76 74 77 USE step_diu ! Time stepping for diurnal sst -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r6140 r7403 24 24 PUBLIC trc_oce_alloc ! function called by nemogcm.F90 25 25 26 LOGICAL , PUBLIC :: l_co2cpl = .false. !: atmospheric pco2 recieved from oasis 26 27 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers 27 28 REAL(wp), PUBLIC :: r_si2 !: largest depth of extinction (blue & 0.01 mg.m-3) (RGB) 28 29 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient 29 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,: ,:) :: facvol !: volume for degraded regions30 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: oce_co2 !: ocean carbon flux 30 31 31 32 #if defined key_top … … 75 76 !! *** trc_oce_alloc *** 76 77 !!---------------------------------------------------------------------- 77 INTEGER :: ierr(2) ! Local variables 78 !!---------------------------------------------------------------------- 79 ierr(:) = 0 80 ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 81 IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 82 trc_oce_alloc = MAXVAL( ierr ) 83 ! 78 ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), STAT=trc_oce_alloc ) 84 79 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 80 ! 85 81 END FUNCTION trc_oce_alloc 86 82 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r6140 r7403 36 36 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 37 37 USE in_out_manager ! I/O manager 38 USE diaar5, ONLY : lk_diaar539 38 USE iom 40 39 USE ioipsl -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
r3680 r7403 10 10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 11 11 !!---------------------------------------------------------------------- 12 USE par_pisces , ONLY : jp_pisces !: number of tracers in PISCES13 USE par_pisces , ONLY : jp_pisces_2d !: number of 2D diag in PISCES14 USE par_pisces , ONLY : jp_pisces_3d !: number of 3D diag in PISCES15 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES16 12 17 13 IMPLICIT NONE 18 19 INTEGER, PARAMETER :: jp_lc = jp_pisces !: cumulative number of passive tracers 20 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d !: 21 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d !: 22 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd !: 23 24 #if defined key_cfc 25 !!--------------------------------------------------------------------- 26 !! 'key_cfc' : CFC tracers 27 !!--------------------------------------------------------------------- 28 LOGICAL, PUBLIC, PARAMETER :: lk_cfc = .TRUE. !: CFC flag 29 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 1 !: number of passive tracers 30 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 2 !: additional 2d output arrays ('key_trc_diaadd') 31 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: additional 3d output arrays ('key_trc_diaadd') 32 INTEGER, PUBLIC, PARAMETER :: jp_cfc_trd = 0 !: number of sms trends for CFC 33 34 ! assign an index in trc arrays for each CFC prognostic variables 35 INTEGER, PUBLIC, PARAMETER :: jpc11 = jp_lc + 1 !: CFC-11 36 INTEGER, PUBLIC, PARAMETER :: jpc12 = jp_lc + 2 !: CFC-12 37 #else 38 !!--------------------------------------------------------------------- 39 !! Default : No CFC tracers 40 !!--------------------------------------------------------------------- 41 LOGICAL, PUBLIC, PARAMETER :: lk_cfc = .FALSE. !: CFC flag 42 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 0 !: No CFC tracers 43 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 0 !: No CFC additional 2d output arrays 44 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: No CFC additional 3d output arrays 45 INTEGER, PUBLIC, PARAMETER :: jp_cfc_trd = 0 !: number of sms trends for CFC 46 #endif 47 48 ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 49 INTEGER, PUBLIC, PARAMETER :: jp_cfc0 = jp_lc + 1 !: First index of CFC tracers 50 INTEGER, PUBLIC, PARAMETER :: jp_cfc1 = jp_lc + jp_cfc !: Last index of CFC tracers 51 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_2d = jp_lc_2d + 1 !: First index of CFC tracers 52 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_2d = jp_lc_2d + jp_cfc_2d !: Last index of CFC tracers 53 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_3d = jp_lc_3d + 1 !: First index of CFC tracers 54 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_3d = jp_lc_3d + jp_cfc_3d !: Last index of CFC tracers 55 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_trd = jp_lc_trd + 1 !: First index of CFC tracers 56 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last index of CFC tracers 14 INTEGER, PUBLIC :: jp_cfc0, jp_cfc1 !: First/last index of CFC tracers 57 15 58 16 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90
r5434 r7403 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 7 !!----------------------------------------------------------------------8 #if defined key_cfc9 !!----------------------------------------------------------------------10 !! 'key_cfc' CFC tracers11 7 !!---------------------------------------------------------------------- 12 8 !! trc_ice_cfc : MY_TRC model main routine … … 40 36 END SUBROUTINE trc_ice_ini_cfc 41 37 42 43 #else44 !!----------------------------------------------------------------------45 !! Dummy module No MY_TRC model46 !!----------------------------------------------------------------------47 CONTAINS48 SUBROUTINE trc_ice_ini_cfc ! Empty routine49 END SUBROUTINE trc_ice_ini_cfc50 #endif51 52 38 !!====================================================================== 53 39 END MODULE trcice_cfc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r3294 r7403 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) 7 7 !!---------------------------------------------------------------------- 8 #if defined key_cfc9 !!----------------------------------------------------------------------10 !! 'key_cfc' CFC tracers11 8 !!---------------------------------------------------------------------- 12 9 !! trc_ini_cfc : CFC model initialisation … … 15 12 USE par_trc ! TOP parameters 16 13 USE trc ! TOP variables 14 USE trcnam_cfc ! CFC SMS namelist 17 15 USE trcsms_cfc ! CFC sms trends 18 16 … … 21 19 22 20 PUBLIC trc_ini_cfc ! called by trcini.F90 module 23 24 CHARACTER (len=34) :: clname = 'cfc1112.atm' ! ???25 21 26 22 INTEGER :: inum ! unit number … … 46 42 INTEGER :: iskip = 6 ! number of 1st descriptor lines 47 43 REAL(wp) :: zyy, zyd 44 CHARACTER(len = 20) :: cltra 48 45 !!---------------------------------------------------------------------- 49 46 ! 47 CALL trc_nam_cfc 48 ! 50 49 IF(lwp) WRITE(numout,*) 51 50 IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 52 51 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 53 54 55 IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 52 ! 53 IF(lwp) WRITE(numout,*) 'Read annual atmospheric concentratioins from formatted file : ' // TRIM(clname) 56 54 57 55 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 66 64 END DO 67 65 100 jpyear = jn - 1 - iskip 68 IF ( lwp) WRITE(numout,*) ' ', jpyear ,' years read'66 IF ( lwp) WRITE(numout,*) ' ---> ', jpyear ,' years read' 69 67 ! ! Allocate CFC arrays 70 68 71 ALLOCATE( p_cfc(jpyear,jphem, 2), STAT=ierr )69 ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 72 70 IF( ierr > 0 ) THEN 73 71 CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' ) ; RETURN … … 87 85 IF(lwp) THEN 88 86 WRITE(numout,*) 89 WRITE(numout,*) 'Initiali zation deqint ; No restart : qint equal zero '87 WRITE(numout,*) 'Initialisation of qint ; No restart : qint equal zero ' 90 88 ENDIF 91 89 qint_cfc(:,:,:) = 0._wp … … 105 103 jn = 31 106 104 DO 107 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1 ,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)105 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 108 106 IF( io < 0 ) exit 109 107 jn = jn + 1 110 108 END DO 111 109 112 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 113 p_cfc(33,1:2,1) = 8.e-4 114 p_cfc(34,1:2,1) = 1.e-6 115 p_cfc(35,1:2,1) = 2.e-3 116 p_cfc(36,1:2,1) = 4.e-3 117 p_cfc(37,1:2,1) = 6.e-3 118 p_cfc(38,1:2,1) = 8.e-3 119 p_cfc(39,1:2,1) = 1.e-2 120 110 !p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 111 !p_cfc(33,1:2,1) = 8.e-4 112 !p_cfc(34,1:2,1) = 1.e-6 113 !p_cfc(35,1:2,1) = 2.e-3 114 !p_cfc(36,1:2,1) = 4.e-3 115 !p_cfc(37,1:2,1) = 6.e-3 116 !p_cfc(38,1:2,1) = 8.e-3 117 !p_cfc(39,1:2,1) = 1.e-2 121 118 IF(lwp) THEN ! Control print 122 119 WRITE(numout,*) 123 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS'120 WRITE(numout,*) ' Year c11NH c11SH c12NH c12SH SF6NH SF6SH' 124 121 DO jn = 30, jpyear 125 WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2)122 WRITE(numout, '( 1I4, 6F10.4)') jn, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 126 123 END DO 127 124 ENDIF … … 145 142 ! 146 143 END SUBROUTINE trc_ini_cfc 147 148 #else149 !!----------------------------------------------------------------------150 !! Dummy module No CFC tracers151 !!----------------------------------------------------------------------152 CONTAINS153 SUBROUTINE trc_ini_cfc ! Empty routine154 END SUBROUTINE trc_ini_cfc155 #endif156 144 157 145 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r4624 r7403 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) from trcnam.cfc.h90 7 7 !!---------------------------------------------------------------------- 8 #if defined key_cfc9 !!----------------------------------------------------------------------10 !! 'key_cfc' CFC tracers11 !!----------------------------------------------------------------------12 8 !! trc_nam_cfc : CFC model initialisation 13 9 !!---------------------------------------------------------------------- 14 10 USE oce_trc ! Ocean variables 15 USE par_trc ! TOP parameters16 11 USE trc ! TOP variables 17 12 USE trcsms_cfc ! CFC specific variable 18 USE iom ! I/O manager19 13 20 14 IMPLICIT NONE 21 15 PRIVATE 16 17 CHARACTER(len=34), PUBLIC :: clname ! Input filename of CFCs atm. concentrations 22 18 23 19 PUBLIC trc_nam_cfc ! called by trcnam.F90 module … … 42 38 !! ** input : Namelist namcfc 43 39 !!---------------------------------------------------------------------- 44 INTEGER :: numnatc_ref = -1 ! Logical unit for reference CFC namelist45 INTEGER :: numnatc_cfg = -1 ! Logical unit for configuration CFC namelist46 INTEGER :: numonc = -1 ! Logical unit for output namelist47 40 INTEGER :: ios ! Local integer output status for namelist read 48 41 INTEGER :: jl, jn 49 TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d50 42 !! 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res 52 NAMELIST/namcfcdia/ cfcdia2d ! additional diagnostics 43 NAMELIST/namcfc/ ndate_beg, nyear_res, clname 53 44 !!---------------------------------------------------------------------- 54 ! ! Open namelist files 55 CALL ctl_opn( numnatc_ref, 'namelist_cfc_ref' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 56 CALL ctl_opn( numnatc_cfg, 'namelist_cfc_cfg' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 57 IF(lwm) CALL ctl_opn( numonc, 'output.namelist.cfc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 45 ! 46 jn = jp_cfc0 - 1 47 ! Variables setting 48 IF( ln_cfc11 ) THEN 49 jn = jn + 1 50 ctrcnm (jn) = 'CFC11' 51 ctrcln (jn) = 'Chlorofluoro carbon 11 Concentration' 52 ctrcun (jn) = 'umolC/L' 53 ln_trc_ini(jn) = .false. 54 ln_trc_sbc(jn) = .false. 55 ln_trc_cbc(jn) = .false. 56 ln_trc_obc(jn) = .false. 57 ENDIF 58 ! 59 IF( ln_cfc12 ) THEN 60 jn = jn + 1 61 ctrcnm (jn) = 'CFC12' 62 ctrcln (jn) = 'Chlorofluoro carbon 12 Concentration' 63 ctrcun (jn) = 'umolC/L' 64 ln_trc_ini(jn) = .false. 65 ln_trc_sbc(jn) = .false. 66 ln_trc_cbc(jn) = .false. 67 ln_trc_obc(jn) = .false. 68 ENDIF 69 ! 70 IF( ln_sf6 ) THEN 71 jn = jn + 1 72 ctrcnm (jn) = 'SF6' 73 ctrcln (jn) = 'Sulfur hexafluoride Concentration' 74 ctrcun (jn) = 'umol/L' 75 ln_trc_ini(jn) = .false. 76 ln_trc_sbc(jn) = .false. 77 ln_trc_cbc(jn) = .false. 78 ln_trc_obc(jn) = .false. 79 ENDIF 80 ! 81 REWIND( numtrc_ref ) ! Namelist namcfcdate in reference namelist : CFC parameters 82 READ ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 83 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 58 84 59 REWIND( numnatc_ref ) ! Namelist namcfcdate in reference namelist : CFC parameters 60 READ ( numnatc_ref, namcfcdate, IOSTAT = ios, ERR = 901) 61 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in reference namelist', lwp ) 62 63 REWIND( numnatc_cfg ) ! Namelist namcfcdate in configuration namelist : CFC parameters 64 READ ( numnatc_cfg, namcfcdate, IOSTAT = ios, ERR = 902 ) 65 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in configuration namelist', lwp ) 66 IF(lwm) WRITE ( numonc, namcfcdate ) 85 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist : CFC parameters 86 READ ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 87 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 88 IF(lwm) WRITE ( numonr, namcfc ) 67 89 68 90 IF(lwp) THEN ! control print 69 WRITE(numout,*) 91 WRITE(numout,*) ' ' 92 WRITE(numout,*) ' CFCs' 93 WRITE(numout,*) ' ' 70 94 WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model' 71 95 WRITE(numout,*) ' ~~~~~~~' … … 76 100 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 77 101 ! 78 79 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 80 ! 81 ! Namelist namcfcdia 82 ! ------------------- 83 REWIND( numnatc_ref ) ! Namelist namcfcdia in reference namelist : CFC diagnostics 84 READ ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903) 85 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp ) 86 87 REWIND( numnatc_cfg ) ! Namelist namcfcdia in configuration namelist : CFC diagnostics 88 READ ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 ) 89 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp ) 90 IF(lwm) WRITE ( numonc, namcfcdia ) 91 92 DO jl = 1, jp_cfc_2d 93 jn = jp_cfc0_2d + jl - 1 94 ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 95 ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 96 ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 97 END DO 98 99 IF(lwp) THEN ! control print 100 WRITE(numout,*) 101 WRITE(numout,*) ' Namelist : natadd' 102 DO jl = 1, jp_cfc_2d 103 jn = jp_cfc0_2d + jl - 1 104 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), & 105 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn) 106 END DO 107 WRITE(numout,*) ' ' 108 ENDIF 109 ! 110 ENDIF 111 112 IF(lwm) CALL FLUSH ( numonc ) ! flush output namelist CFC 102 IF(lwm) CALL FLUSH ( numonr ) ! flush output namelist CFC 113 103 114 104 END SUBROUTINE trc_nam_cfc 115 105 116 #else117 !!----------------------------------------------------------------------118 !! Dummy module : No CFC119 !!----------------------------------------------------------------------120 CONTAINS121 SUBROUTINE trc_nam_cfc ! Empty routine122 END SUBROUTINE trc_nam_cfc123 #endif124 125 106 !!====================================================================== 126 107 END MODULE trcnam_cfc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r6140 r7403 7 7 !! NEMO 1.0 ! 2004-03 (C. Ethe) free form + modularity 8 8 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation 9 !!---------------------------------------------------------------------- 10 #if defined key_cfc 11 !!---------------------------------------------------------------------- 12 !! 'key_cfc' CFC tracers 9 !! 4.0 ! 2016-11 (T. Lovato) Add SF6, Update Schmidt number 13 10 !!---------------------------------------------------------------------- 14 11 !! trc_sms_cfc : compute and add CFC suface forcing to CFC trends … … 29 26 30 27 INTEGER , PUBLIC, PARAMETER :: jphem = 2 ! parameter for the 2 hemispheres 31 INTEGER , PUBLIC :: jpyear ! Number of years read in CFC1112 file28 INTEGER , PUBLIC :: jpyear ! Number of years read in input data file (in trcini_cfc) 32 29 INTEGER , PUBLIC :: ndate_beg ! initial calendar date (aammjj) for CFC 33 30 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 34 31 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) 35 32 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: p_cfc ! partial hemispheric pressure for CFC33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: p_cfc ! partial hemispheric pressure for all CFC 37 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: xphem ! spatial interpolation factor for patm 38 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_cfc ! flux at surface 39 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qint_cfc ! cumulative flux 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: atm_cfc ! partial hemispheric pressure for used CFC 40 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric function 41 39 42 REAL(wp), DIMENSION(4,2) :: soa! coefficient for solubility of CFC [mol/l/atm]43 REAL(wp), DIMENSION(3,2) :: sob! " "44 REAL(wp), DIMENSION(4,2) :: sca ! coefficients for schmidt number in degre Celcius40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soa ! coefficient for solubility of CFC [mol/l/atm] 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sob ! " " 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sca ! coefficients for schmidt number in degrees Celsius 45 43 46 44 ! ! coefficients for conversion … … 79 77 INTEGER :: im1, im2, ierr 80 78 REAL(wp) :: ztap, zdtap 81 REAL(wp) :: zt1, zt2, zt3, z v279 REAL(wp) :: zt1, zt2, zt3, zt4, zv2 82 80 REAL(wp) :: zsol ! solubility 83 81 REAL(wp) :: zsch ! schmidt number … … 117 115 ! time interpolation at time kt 118 116 DO jm = 1, jphem 119 zpatm(jm,jl) = ( p_cfc(iyear_beg, jm, jl) * FLOAT (im1) &120 & + p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12.117 zpatm(jm,jl) = ( atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp) & 118 & + atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. 121 119 END DO 122 120 … … 145 143 146 144 ! Computation of speed transfert 147 ! Schmidt number 145 ! Schmidt number revised in Wanninkhof (2014) 148 146 zt1 = tsn(ji,jj,1,jp_tem) 149 147 zt2 = zt1 * zt1 150 148 zt3 = zt1 * zt2 151 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 152 153 ! speed transfert : formulae of wanninkhof 1992 149 zt4 = zt2 * zt2 150 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 151 152 ! speed transfert : formulae revised in Wanninkhof (2014) 154 153 zv2 = wndm(ji,jj) * wndm(ji,jj) 155 154 zsch = zsch / 660. 156 zak_cfc = ( 0.3 9* xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)155 zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 157 156 158 157 ! Input function : speed *( conc. at equil - concen at surface ) 159 158 ! trn in pico-mol/l idem qtr; ak in en m/a 160 159 qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc ) & 161 #if defined key_degrad162 & * facvol(ji,jj,1) &163 #endif164 160 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 165 161 ! Add the surface flux to the trend … … 185 181 ! 186 182 IF( lk_iomput ) THEN 187 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 188 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 189 ELSE 190 IF( ln_diatrc ) THEN 191 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 192 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 193 END IF 183 DO jn = jp_cfc0, jp_cfc1 184 CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) ) 185 CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 186 ENDDO 194 187 END IF 195 188 ! … … 212 205 !!--------------------------------------------------------------------- 213 206 INTEGER :: jn 214 207 !!---------------------------------------------------------------------- 208 ! 209 jn = 0 215 210 ! coefficient for CFC11 216 211 !---------------------- 217 218 ! Solubility 219 soa(1,1) = -229.9261 220 soa(2,1) = 319.6552 221 soa(3,1) = 119.4471 222 soa(4,1) = -1.39165 223 224 sob(1,1) = -0.142382 225 sob(2,1) = 0.091459 226 sob(3,1) = -0.0157274 227 228 ! Schmidt number 229 sca(1,1) = 3501.8 230 sca(2,1) = -210.31 231 sca(3,1) = 6.1851 232 sca(4,1) = -0.07513 212 if ( ln_cfc11 ) then 213 jn = jn + 1 214 ! Solubility 215 soa(1,jn) = -229.9261 216 soa(2,jn) = 319.6552 217 soa(3,jn) = 119.4471 218 soa(4,jn) = -1.39165 219 220 sob(1,jn) = -0.142382 221 sob(2,jn) = 0.091459 222 sob(3,jn) = -0.0157274 223 224 ! Schmidt number 225 sca(1,jn) = 3579.2 226 sca(2,jn) = -222.63 227 sca(3,jn) = 7.5749 228 sca(4,jn) = -0.14595 229 sca(5,jn) = 0.0011874 230 231 ! atm. concentration 232 atm_cfc(:,:,jn) = p_cfc(:,:,1) 233 endif 233 234 234 235 ! coefficient for CFC12 235 236 !---------------------- 236 237 ! Solubility 238 soa(1,2) = -218.0971 239 soa(2,2) = 298.9702 240 soa(3,2) = 113.8049 241 soa(4,2) = -1.39165 242 243 sob(1,2) = -0.143566 244 sob(2,2) = 0.091015 245 sob(3,2) = -0.0153924 246 247 ! schmidt number 248 sca(1,2) = 3845.4 249 sca(2,2) = -228.95 250 sca(3,2) = 6.1908 251 sca(4,2) = -0.067430 237 if ( ln_cfc12 ) then 238 jn = jn + 1 239 ! Solubility 240 soa(1,jn) = -218.0971 241 soa(2,jn) = 298.9702 242 soa(3,jn) = 113.8049 243 soa(4,jn) = -1.39165 244 245 sob(1,jn) = -0.143566 246 sob(2,jn) = 0.091015 247 sob(3,jn) = -0.0153924 248 249 ! schmidt number 250 sca(1,jn) = 3828.1 251 sca(2,jn) = -249.86 252 sca(3,jn) = 8.7603 253 sca(4,jn) = -0.1716 254 sca(5,jn) = 0.001408 255 256 ! atm. concentration 257 atm_cfc(:,:,jn) = p_cfc(:,:,2) 258 endif 259 260 ! coefficient for SF6 261 !---------------------- 262 if ( ln_sf6 ) then 263 jn = jn + 1 264 ! Solubility 265 soa(1,jn) = -80.0343 266 soa(2,jn) = 117.232 267 soa(3,jn) = 29.5817 268 soa(4,jn) = 0.0 269 270 sob(1,jn) = 0.0335183 271 sob(2,jn) = -0.0373942 272 sob(3,jn) = 0.00774862 273 274 ! schmidt number 275 sca(1,jn) = 3177.5 276 sca(2,jn) = -200.57 277 sca(3,jn) = 6.8865 278 sca(4,jn) = -0.13335 279 sca(5,jn) = 0.0010877 280 281 ! atm. concentration 282 atm_cfc(:,:,jn) = p_cfc(:,:,3) 283 endif 252 284 253 285 IF( ln_rsttr ) THEN … … 269 301 !! *** ROUTINE trc_sms_cfc_alloc *** 270 302 !!---------------------------------------------------------------------- 271 ALLOCATE( xphem (jpi,jpj) , & 272 & qtr_cfc (jpi,jpj,jp_cfc) , & 273 & qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 303 ALLOCATE( xphem (jpi,jpj) , atm_cfc(jpyear,jphem,jp_cfc) , & 304 & qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc) , & 305 & soa(4,jp_cfc) , sob(3,jp_cfc) , sca(5,jp_cfc) , & 306 & STAT=trc_sms_cfc_alloc ) 274 307 ! 275 308 IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') … … 277 310 END FUNCTION trc_sms_cfc_alloc 278 311 279 #else280 !!----------------------------------------------------------------------281 !! Dummy module No CFC tracers282 !!----------------------------------------------------------------------283 CONTAINS284 SUBROUTINE trc_sms_cfc( kt ) ! Empty routine285 WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt286 END SUBROUTINE trc_sms_cfc287 #endif288 289 312 !!====================================================================== 290 313 END MODULE trcsms_cfc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
r5836 r7403 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && defined key_cfc && defined key_iomput 9 !!---------------------------------------------------------------------- 10 !! 'key_cfc' cfc model 8 #if defined key_top && defined key_iomput 11 9 !!---------------------------------------------------------------------- 12 10 !! trc_wri_cfc : outputs of concentration fields -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
r3680 r7403 10 10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 11 11 !!---------------------------------------------------------------------- 12 USE par_pisces , ONLY : jp_pisces !: number of tracers in PISCES13 USE par_pisces , ONLY : jp_pisces_2d !: number of 2D diag in PISCES14 USE par_pisces , ONLY : jp_pisces_3d !: number of 3D diag in PISCES15 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES16 17 USE par_cfc , ONLY : jp_cfc !: number of tracers in CFC18 USE par_cfc , ONLY : jp_cfc_2d !: number of tracers in CFC19 USE par_cfc , ONLY : jp_cfc_3d !: number of tracers in CFC20 USE par_cfc , ONLY : jp_cfc_trd !: number of tracers in CFC21 22 USE par_c14b , ONLY : jp_c14b !: number of tracers in C1423 USE par_c14b , ONLY : jp_c14b_2d !: number of tracers in C1424 USE par_c14b , ONLY : jp_c14b_3d !: number of tracers in C1425 USE par_c14b , ONLY : jp_c14b_trd !: number of tracers in C1426 12 27 13 IMPLICIT NONE 28 14 29 INTEGER, PARAMETER :: jp_lm = jp_pisces + jp_cfc + jp_c14b !:30 INTEGER, PARAMETER :: jp_lm_2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d !:31 INTEGER, PARAMETER :: jp_lm_3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d !:32 INTEGER, PARAMETER :: jp_lm_trd = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !:33 34 #if defined key_my_trc35 !!---------------------------------------------------------------------36 !! 'key_my_trc' user defined tracers (MY_TRC)37 !!---------------------------------------------------------------------38 LOGICAL, PUBLIC, PARAMETER :: lk_my_trc = .TRUE. !: PTS flag39 INTEGER, PUBLIC, PARAMETER :: jp_my_trc = 1 !: number of PTS tracers40 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_2d = 0 !: additional 2d output arrays ('key_trc_diaadd')41 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_3d = 0 !: additional 3d output arrays ('key_trc_diaadd')42 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_trd = 0 !: number of sms trends for MY_TRC43 44 ! assign an index in trc arrays for each PTS prognostic variables45 INTEGER, PUBLIC, PARAMETER :: jpmyt1 = jp_lm + 1 !: 1st MY_TRC tracer46 47 #else48 !!---------------------------------------------------------------------49 !! Default No user defined tracers (MY_TRC)50 !!---------------------------------------------------------------------51 LOGICAL, PUBLIC, PARAMETER :: lk_my_trc = .FALSE. !: MY_TRC flag52 INTEGER, PUBLIC, PARAMETER :: jp_my_trc = 0 !: No MY_TRC tracers53 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_2d = 0 !: No MY_TRC additional 2d output arrays54 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_3d = 0 !: No MY_TRC additional 3d output arrays55 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_trd = 0 !: number of sms trends for MY_TRC56 #endif57 58 15 ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 59 INTEGER, PUBLIC, PARAMETER :: jp_myt0 = jp_lm + 1 !: First index of MY_TRC passive tracers 60 INTEGER, PUBLIC, PARAMETER :: jp_myt1 = jp_lm + jp_my_trc !: Last index of MY_TRC passive tracers 61 INTEGER, PUBLIC, PARAMETER :: jp_myt0_2d = jp_lm_2d + 1 !: First index of MY_TRC passive tracers 62 INTEGER, PUBLIC, PARAMETER :: jp_myt1_2d = jp_lm_2d + jp_my_trc_2d !: Last index of MY_TRC passive tracers 63 INTEGER, PUBLIC, PARAMETER :: jp_myt0_3d = jp_lm_3d + 1 !: First index of MY_TRC passive tracers 64 INTEGER, PUBLIC, PARAMETER :: jp_myt1_3d = jp_lm_3d + jp_my_trc_3d !: Last index of MY_TRC passive tracers 65 INTEGER, PUBLIC, PARAMETER :: jp_myt0_trd = jp_lm_trd + 1 !: First index of MY_TRC passive tracers 66 INTEGER, PUBLIC, PARAMETER :: jp_myt1_trd = jp_lm_trd + jp_my_trc_trd !: Last index of MY_TRC passive tracers 67 16 INTEGER, PUBLIC :: jp_myt0 !: First index of MY_TRC passive tracers 17 INTEGER, PUBLIC :: jp_myt1 !: Last index of MY_TRC passive tracers 68 18 !!====================================================================== 69 19 END MODULE par_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90
r5439 r7403 3 3 !! *** MODULE trcice_my_trc *** 4 4 !!---------------------------------------------------------------------- 5 #if defined key_my_trc 5 !! trc_ice_my_trc : MY_TRC model seaice coupling routine 6 6 !!---------------------------------------------------------------------- 7 !! 'key_my_trc' CFC tracers 8 !!---------------------------------------------------------------------- 9 !! trc_ice_my_trc : MY_TRC model main routine 7 !! History : ! 2016 (C. Ethe, T. Lovato) Revised architecture 10 8 !!---------------------------------------------------------------------- 11 9 USE par_trc ! TOP parameters … … 19 17 20 18 !!---------------------------------------------------------------------- 21 !! NEMO/TOP 3.3 , NEMO Consortium (2010)22 !! $Id : trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham$19 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 20 !! $Id$ 23 21 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 24 22 !!---------------------------------------------------------------------- … … 34 32 END SUBROUTINE trc_ice_ini_my_trc 35 33 36 #else37 !!----------------------------------------------------------------------38 !! Dummy module No MY_TRC model39 !!----------------------------------------------------------------------40 CONTAINS41 SUBROUTINE trc_ice_ini_my_trc ! Empty routine42 END SUBROUTINE trc_ice_ini_my_trc43 #endif44 45 34 !!====================================================================== 46 35 END MODULE trcice_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
r5385 r7403 4 4 !! TOP : initialisation of the MY_TRC tracers 5 5 !!====================================================================== 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 7 !!---------------------------------------------------------------------- 8 #if defined key_my_trc 9 !!---------------------------------------------------------------------- 10 !! 'key_my_trc' CFC tracers 6 !! History : ! 2007 (C. Ethe, G. Madec) Original code 7 !! ! 2016 (C. Ethe, T. Lovato) Revised architecture 11 8 !!---------------------------------------------------------------------- 12 9 !! trc_ini_my_trc : MY_TRC model initialisation … … 15 12 USE oce_trc 16 13 USE trc 14 USE par_my_trc 15 USE trcnam_my_trc ! MY_TRC SMS namelist 17 16 USE trcsms_my_trc 18 17 … … 23 22 24 23 !!---------------------------------------------------------------------- 25 !! NEMO/TOP 3.3 , NEMO Consortium (2010)24 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 26 25 !! $Id$ 27 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 37 36 !! ** Method : - Read the namcfc namelist and check the parameter values 38 37 !!---------------------------------------------------------------------- 39 38 ! 39 CALL trc_nam_my_trc 40 ! 40 41 ! ! Allocate MY_TRC arrays 41 42 IF( trc_sms_my_trc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) … … 53 54 END SUBROUTINE trc_ini_my_trc 54 55 55 #else56 !!----------------------------------------------------------------------57 !! Dummy module No MY_TRC model58 !!----------------------------------------------------------------------59 CONTAINS60 SUBROUTINE trc_ini_my_trc ! Empty routine61 END SUBROUTINE trc_ini_my_trc62 #endif63 64 56 !!====================================================================== 65 57 END MODULE trcini_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90
r3680 r7403 4 4 !! TOP : initialisation of some run parameters for MY_TRC bio-model 5 5 !!====================================================================== 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 7 !!---------------------------------------------------------------------- 8 #if defined key_my_trc 9 !!---------------------------------------------------------------------- 10 !! 'key_my_trc' : MY_TRC model 6 !! History : ! 2007 (C. Ethe, G. Madec) Original code 7 !! ! 2016 (C. Ethe, T. Lovato) Revised architecture 11 8 !!---------------------------------------------------------------------- 12 9 !! trc_nam_my_trc : MY_TRC model initialisation … … 22 19 23 20 !!---------------------------------------------------------------------- 24 !! NEMO/TOP 3.3 , NEMO Consortium (2010)21 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 25 22 !! $Id$ 26 23 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 40 END SUBROUTINE trc_nam_my_trc 44 41 45 #else46 !!----------------------------------------------------------------------47 !! Dummy module : No MY_TRC48 !!----------------------------------------------------------------------49 CONTAINS50 SUBROUTINE trc_nam_my_trc ! Empty routine51 END SUBROUTINE trc_nam_my_trc52 #endif53 54 42 !!====================================================================== 55 43 END MODULE trcnam_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r6140 r7403 4 4 !! TOP : Main module of the MY_TRC tracers 5 5 !!====================================================================== 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 7 !!---------------------------------------------------------------------- 8 #if defined key_my_trc 9 !!---------------------------------------------------------------------- 10 !! 'key_my_trc' CFC tracers 6 !! History : ! 2007 (C. Ethe, G. Madec) Original code 7 !! ! 2016 (C. Ethe, T. Lovato) Revised architecture 11 8 !!---------------------------------------------------------------------- 12 9 !! trc_sms_my_trc : MY_TRC model main routine … … 18 15 USE trd_oce 19 16 USE trdtrc 20 USE trcbc, only : trc_bc _read17 USE trcbc, only : trc_bc 21 18 22 19 IMPLICIT NONE … … 29 26 30 27 !!---------------------------------------------------------------------- 31 !! NEMO/TOP 3.3 , NEMO Consortium (2010)28 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 32 29 !! $Id$ 33 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 57 54 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 58 55 59 CALL trc_bc _read( kt ) ! tracers: surface and lateral Boundary Conditions56 CALL trc_bc ( kt ) ! tracers: surface and lateral Boundary Conditions 60 57 61 58 ! add here the call to BGC model … … 74 71 END SUBROUTINE trc_sms_my_trc 75 72 76 77 73 INTEGER FUNCTION trc_sms_my_trc_alloc() 78 74 !!---------------------------------------------------------------------- … … 88 84 END FUNCTION trc_sms_my_trc_alloc 89 85 90 91 #else92 !!----------------------------------------------------------------------93 !! Dummy module No MY_TRC model94 !!----------------------------------------------------------------------95 CONTAINS96 SUBROUTINE trc_sms_my_trc( kt ) ! Empty routine97 INTEGER, INTENT( in ) :: kt98 WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt99 END SUBROUTINE trc_sms_my_trc100 #endif101 102 86 !!====================================================================== 103 87 END MODULE trcsms_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r6140 r7403 2 2 !!====================================================================== 3 3 !! *** MODULE trcwri *** 4 !! my_trc : Output of my_trc tracers4 !! trc_wri_my_trc : outputs of concentration fields 5 5 !!====================================================================== 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 6 #if defined key_top && defined key_iomput 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && defined key_my_trc && defined key_iomput 8 !! History : ! 2007 (C. Ethe, G. Madec) Original code 9 !! ! 2016 (C. Ethe, T. Lovato) Revised architecture 9 10 !!---------------------------------------------------------------------- 10 !! 'key_my_trc' my_trc model 11 !!---------------------------------------------------------------------- 12 !! trc_wri_my_trc : outputs of concentration fields 13 !!---------------------------------------------------------------------- 11 USE par_trc ! passive tracers common variables 14 12 USE trc ! passive tracers common variables 15 13 USE iom ! I/O manager … … 20 18 PUBLIC trc_wri_my_trc 21 19 20 !!---------------------------------------------------------------------- 21 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 22 !! $Id$ 23 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 24 !!---------------------------------------------------------------------- 22 25 CONTAINS 23 26 … … 36 39 DO jn = jp_myt0, jp_myt1 37 40 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 38 IF( ln_trc_wri(jn) )CALL iom_put( cltra, trn(:,:,:,jn) )41 CALL iom_put( cltra, trn(:,:,:,jn) ) 39 42 END DO 40 43 ! … … 42 45 43 46 #else 44 !!---------------------------------------------------------------------- 45 !! Dummy module : No passive tracer 46 !!---------------------------------------------------------------------- 47 PUBLIC trc_wri_my_trc 47 48 48 CONTAINS 49 SUBROUTINE trc_wri_my_trc ! Empty routine 49 50 SUBROUTINE trc_wri_my_trc 51 ! 50 52 END SUBROUTINE trc_wri_my_trc 53 51 54 #endif 52 55 53 !!----------------------------------------------------------------------54 !! NEMO/TOP 3.3 , NEMO Consortium (2010)55 !! $Id: trcwri_my_trc.F90 3160 2011-11-20 14:27:18Z cetlod $56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)57 !!======================================================================58 56 END MODULE trcwri_my_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r6140 r7403 8 8 !! - ! 2001-03 (M. Levy) LNO3 + dia2d 9 9 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 10 !!----------------------------------------------------------------------11 #if defined key_pisces_reduced12 !!----------------------------------------------------------------------13 !! 'key_pisces_reduced' LOBSTER bio-model14 10 !!---------------------------------------------------------------------- 15 11 !! p2z_bio : … … 86 82 !! source sink 87 83 !! 88 !! IF 'key_diabio' defined , the biogeochemical trends89 !! for passive tracers are saved for futher diagnostics.90 84 !!--------------------------------------------------------------------- 91 85 !! … … 109 103 IF( nn_timing == 1 ) CALL timing_start('p2z_bio') 110 104 ! 111 IF( l n_diatrc .OR. lk_iomput ) THEN105 IF( lk_iomput ) THEN 112 106 CALL wrk_alloc( jpi, jpj, 17, zw2d ) 113 107 CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) … … 121 115 122 116 xksi(:,:) = 0.e0 ! zooplakton closure ( fbod) 123 IF( l n_diatrc .OR. lk_iomput ) THEN117 IF( lk_iomput ) THEN 124 118 zw2d (:,:,:) = 0.e0 125 119 zw3d(:,:,:,:) = 0.e0 … … 218 212 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 219 213 220 221 IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 222 trbio(ji,jj,jk,jp_pcs0_trd ) = zno3phy 223 trbio(ji,jj,jk,jp_pcs0_trd + 1) = znh4phy 224 trbio(ji,jj,jk,jp_pcs0_trd + 2) = zphynh4 225 trbio(ji,jj,jk,jp_pcs0_trd + 3) = zphydom 226 trbio(ji,jj,jk,jp_pcs0_trd + 4) = zphyzoo 227 trbio(ji,jj,jk,jp_pcs0_trd + 5) = zphydet 228 trbio(ji,jj,jk,jp_pcs0_trd + 6) = zdetzoo 229 ! trend number 8 in p2zsed 230 trbio(ji,jj,jk,jp_pcs0_trd + 8) = zzoodet 231 trbio(ji,jj,jk,jp_pcs0_trd + 9) = zzoobod 232 trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 233 trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 234 trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 235 trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 236 trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 237 trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 238 ! trend number 17 in p2zexp 239 ENDIF 240 IF( ln_diatrc .OR. lk_iomput ) THEN 214 IF( lk_iomput ) THEN 241 215 ! convert fluxes in per day 242 216 ze3t = e3t_n(ji,jj,jk) * 86400._wp … … 340 314 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 341 315 ! 342 IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 343 trbio(ji,jj,jk,jp_pcs0_trd ) = zno3phy 344 trbio(ji,jj,jk,jp_pcs0_trd + 1) = znh4phy 345 trbio(ji,jj,jk,jp_pcs0_trd + 2) = zphynh4 346 trbio(ji,jj,jk,jp_pcs0_trd + 3) = zphydom 347 trbio(ji,jj,jk,jp_pcs0_trd + 4) = zphyzoo 348 trbio(ji,jj,jk,jp_pcs0_trd + 5) = zphydet 349 trbio(ji,jj,jk,jp_pcs0_trd + 6) = zdetzoo 350 ! trend number 8 in p2zsed 351 trbio(ji,jj,jk,jp_pcs0_trd + 8) = zzoodet 352 trbio(ji,jj,jk,jp_pcs0_trd + 9) = zzoobod 353 trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 354 trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 355 trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 356 trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 357 trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 358 trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 359 ! trend number 17 in p2zexp 360 ENDIF 361 IF( ln_diatrc .OR. lk_iomput ) THEN 316 IF( lk_iomput ) THEN 362 317 ! convert fluxes in per day 363 318 ze3t = e3t_n(ji,jj,jk) * 86400._wp … … 389 344 END DO 390 345 391 IF( l n_diatrc .OR. lk_iomput ) THEN346 IF( lk_iomput ) THEN 392 347 DO jl = 1, 17 393 348 CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) … … 420 375 CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 421 376 ! 422 ELSE423 IF( ln_diatrc ) THEN424 !425 trc2d(:,:,jp_pcs0_2d ) = zw2d(:,:,1)426 trc2d(:,:,jp_pcs0_2d + 1) = zw2d(:,:,2)427 trc2d(:,:,jp_pcs0_2d + 2) = zw2d(:,:,3)428 trc2d(:,:,jp_pcs0_2d + 3) = zw2d(:,:,4)429 trc2d(:,:,jp_pcs0_2d + 4) = zw2d(:,:,5)430 trc2d(:,:,jp_pcs0_2d + 5) = zw2d(:,:,6)431 trc2d(:,:,jp_pcs0_2d + 6) = zw2d(:,:,7)432 ! trend number 8 is in p2zsed.F433 trc2d(:,:,jp_pcs0_2d + 8) = zw2d(:,:,8)434 trc2d(:,:,jp_pcs0_2d + 9) = zw2d(:,:,9)435 trc2d(:,:,jp_pcs0_2d + 10) = zw2d(:,:,10)436 trc2d(:,:,jp_pcs0_2d + 11) = zw2d(:,:,11)437 trc2d(:,:,jp_pcs0_2d + 12) = zw2d(:,:,12)438 trc2d(:,:,jp_pcs0_2d + 13) = zw2d(:,:,13)439 trc2d(:,:,jp_pcs0_2d + 14) = zw2d(:,:,14)440 trc2d(:,:,jp_pcs0_2d + 15) = zw2d(:,:,15)441 trc2d(:,:,jp_pcs0_2d + 16) = zw2d(:,:,16)442 trc2d(:,:,jp_pcs0_2d + 17) = zw2d(:,:,17)443 ! trend number 19 is in p2zexp.F444 trc3d(:,:,:,jp_pcs0_3d ) = zw3d(:,:,:,1)445 trc3d(:,:,:,jp_pcs0_3d + 1) = zw3d(:,:,:,2)446 trc3d(:,:,:,jp_pcs0_3d + 2) = zw3d(:,:,:,3)447 ENDIF448 !449 ENDIF450 451 IF( ln_diabio .AND. .NOT. lk_iomput ) THEN452 DO jl = jp_pcs0_trd, jp_pcs1_trd453 CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. )454 END DO455 ENDIF456 !457 IF( l_trdtrc ) THEN458 DO jl = jp_pcs0_trd, jp_pcs1_trd459 CALL trd_trc( trbio(:,:,:,jl), jl, kt ) ! handle the trend460 END DO461 377 ENDIF 462 378 … … 467 383 ENDIF 468 384 ! 469 IF( l n_diatrc .OR. lk_iomput ) THEN385 IF( lk_iomput ) THEN 470 386 CALL wrk_dealloc( jpi, jpj, 17, zw2d ) 471 387 CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) … … 586 502 END SUBROUTINE p2z_bio_init 587 503 588 #else589 !!======================================================================590 !! Dummy module : No PISCES bio-model591 !!======================================================================592 CONTAINS593 SUBROUTINE p2z_bio( kt ) ! Empty routine594 INTEGER, INTENT( in ) :: kt595 WRITE(*,*) 'p2z_bio: You should not have seen this print! error?', kt596 END SUBROUTINE p2z_bio597 #endif598 599 504 !!====================================================================== 600 505 END MODULE p2zbio -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r6140 r7403 10 10 !! 3.5 ! 2012-03 (C. Ethe) Merge PISCES-LOBSTER 11 11 !!---------------------------------------------------------------------- 12 #if defined key_pisces_reduced13 !!----------------------------------------------------------------------14 !! 'key_pisces_reduced' LOBSTER bio-model15 !!----------------------------------------------------------------------16 12 !! p2z_exp : Compute loss of organic matter in the sediments 17 13 !!---------------------------------------------------------------------- … … 68 64 INTEGER :: ji, jj, jk, jl, ikt 69 65 REAL(wp) :: zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrbio71 66 REAL(wp), POINTER, DIMENSION(:,:) :: zsedpoca 72 67 CHARACTER (len=25) :: charout … … 80 75 zsedpoca(:,:) = 0. 81 76 82 IF( l_trdtrc ) THEN83 CALL wrk_alloc( jpi, jpj, jpk, ztrbio ) ! temporary save of trends84 ztrbio(:,:,:) = tra(:,:,:,jpno3)85 ENDIF86 77 87 78 ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC … … 126 117 127 118 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 128 IF( lk_iomput ) THEN 129 CALL iom_put( "SEDPOC" , sedpocn ) 130 ELSE 131 IF( ln_diatrc ) trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:) 132 ENDIF 119 IF( lk_iomput ) CALL iom_put( "SEDPOC" , sedpocn ) 133 120 134 121 … … 160 147 ENDIF 161 148 ! 162 IF( l_trdtrc ) THEN163 ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:)164 jl = jp_pcs0_trd + 16165 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend166 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) ! temporary save of trends167 ENDIF168 !169 149 CALL wrk_dealloc( jpi, jpj, zsedpoca) ! temporary save of trends 170 150 … … 281 261 END FUNCTION p2z_exp_alloc 282 262 283 #else284 !!======================================================================285 !! Dummy module : No PISCES bio-model286 !!======================================================================287 CONTAINS288 SUBROUTINE p2z_exp( kt ) ! Empty routine289 INTEGER, INTENT( in ) :: kt290 WRITE(*,*) 'p2z_exp: You should not have seen this print! error?', kt291 END SUBROUTINE p2z_exp292 #endif293 294 263 !!====================================================================== 295 264 END MODULE p2zexp -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r6140 r7403 10 10 !! NEMO 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 11 11 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) minor optimisation + style 12 !!----------------------------------------------------------------------13 #if defined key_pisces_reduced14 !!----------------------------------------------------------------------15 !! 'key_pisces_reduced' LOBSTER bio-model16 12 !!---------------------------------------------------------------------- 17 13 !! p2z_opt : Compute the light availability in the water column … … 208 204 END SUBROUTINE p2z_opt_init 209 205 210 #else211 !!======================================================================212 !! Dummy module : No PISCES bio-model213 !!======================================================================214 CONTAINS215 SUBROUTINE p2z_opt( kt ) ! Empty routine216 INTEGER, INTENT( in ) :: kt217 WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt218 END SUBROUTINE p2z_opt219 #endif220 221 206 !!====================================================================== 222 207 END MODULE p2zopt -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r6140 r7403 7 7 !! - ! 2000-12 (E. Kestenare) clean up 8 8 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 + simplifications 9 !!----------------------------------------------------------------------10 #if defined key_pisces_reduced11 !!----------------------------------------------------------------------12 !! 'key_pisces_reduced' LOBSTER bio-model13 9 !!---------------------------------------------------------------------- 14 10 !! p2z_sed : Compute loss of organic matter in the sediments … … 66 62 CHARACTER (len=25) :: charout 67 63 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra , ztrbio64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra 69 65 !!--------------------------------------------------------------------- 70 66 ! … … 79 75 ! Allocate temporary workspace 80 76 CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra ) 81 IF( l_trdtrc ) THEN82 CALL wrk_alloc( jpi, jpj, jpk, ztrbio )83 ztrbio(:,:,:) = tra(:,:,:,jpdet)84 ENDIF85 77 86 78 ! sedimentation of detritus : upstream scheme … … 116 108 CALL wrk_dealloc( jpi, jpj, zw2d ) 117 109 ENDIF 118 ELSE119 IF( ln_diatrc ) THEN120 CALL wrk_alloc( jpi, jpj, zw2d )121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp122 DO jk = 2, jpkm1123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp124 END DO125 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)126 CALL wrk_dealloc( jpi, jpj, zw2d )127 ENDIF128 110 ENDIF 129 111 ! 130 IF( ln_diabio .AND. .NOT. lk_iomput ) trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)131 112 CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra ) 132 113 ! 133 IF( l_trdtrc ) THEN134 ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)135 jl = jp_pcs0_trd + 7136 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend137 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )138 ENDIF139 114 140 115 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 180 155 END SUBROUTINE p2z_sed_init 181 156 182 #else183 !!======================================================================184 !! Dummy module : No PISCES bio-model185 !!======================================================================186 CONTAINS187 SUBROUTINE p2z_sed( kt ) ! Empty routine188 INTEGER, INTENT( in ) :: kt189 WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt190 END SUBROUTINE p2z_sed191 #endif192 193 157 !!====================================================================== 194 158 END MODULE p2zsed -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
r5656 r7403 6 6 !! History : 1.0 ! M. Levy 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 8 !!----------------------------------------------------------------------9 #if defined key_pisces_reduced10 !!----------------------------------------------------------------------11 !! 'key_pisces_reduced' LOBSTER bio-model12 8 !!---------------------------------------------------------------------- 13 9 !! p2zsms : Time loop of passive tracers sms … … 72 68 END SUBROUTINE p2z_sms 73 69 74 #else75 !!======================================================================76 !! Dummy module : No passive tracer77 !!======================================================================78 CONTAINS79 SUBROUTINE p2z_sms( kt ) ! Empty routine80 INTEGER, INTENT( in ) :: kt81 WRITE(*,*) 'p2z_sms: You should not have seen this print! error?', kt82 END SUBROUTINE p2z_sms83 #endif84 85 70 !!====================================================================== 86 71 END MODULE p2zsms -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r6140 r7403 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !!----------------------------------------------------------------------9 #if defined key_pisces10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES bio-model12 8 !!---------------------------------------------------------------------- 13 9 !! p4z_bio : computes the interactions between the different … … 24 20 USE p4zmicro ! Sources and sinks of microzooplankton 25 21 USE p4zmeso ! Sources and sinks of mesozooplankton 22 USE p5zlim ! Co-limitations of differents nutrients 23 USE p5zprod ! Growth rate of the 2 phyto groups 24 USE p5zmort ! Mortality terms for phytoplankton 25 USE p5zmicro ! Sources and sinks of microzooplankton 26 USE p5zmeso ! Sources and sinks of mesozooplankton 26 27 USE p4zrem ! Remineralisation of organic matter 28 USE p4zpoc ! Remineralization of organic particles 29 USE p4zagg ! Aggregation of particles 27 30 USE p4zfechem 31 USE p4zligand ! Prognostic ligand model 28 32 USE prtctl_trc ! print control for debugging 29 33 USE iom ! I/O manager … … 73 77 END DO 74 78 75 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 76 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter 77 CALL p4z_fechem(kt, knt ) ! Iron chemistry/scavenging 78 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients 79 CALL p4z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean. 80 ! ! (for each element : C, Si, Fe, Chl ) 81 CALL p4z_mort ( kt ) ! phytoplankton mortality 82 ! ! zooplankton sources/sinks routines 83 CALL p4z_micro( kt, knt ) ! microzooplankton 84 CALL p4z_meso ( kt, knt ) ! mesozooplankton 85 CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe 86 ! ! test if tracers concentrations fall below 0. 79 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 80 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter 81 CALL p4z_fechem ( kt, knt ) ! Iron chemistry/scavenging 82 ! 83 IF( ln_p4z ) THEN 84 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients 85 CALL p4z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean. 86 ! ! (for each element : C, Si, Fe, Chl ) 87 CALL p4z_mort ( kt ) ! phytoplankton mortality 88 ! ! zooplankton sources/sinks routines 89 CALL p4z_micro( kt, knt ) ! microzooplankton 90 CALL p4z_meso ( kt, knt ) ! mesozooplankton 91 ELSE 92 CALL p5z_lim ( kt, knt ) ! co-limitations by the various nutrients 93 CALL p5z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean. 94 ! ! (for each element : C, Si, Fe, Chl ) 95 CALL p5z_mort ( kt ) ! phytoplankton mortality 96 ! ! zooplankton sources/sinks routines 97 CALL p5z_micro( kt, knt ) ! microzooplankton 98 CALL p5z_meso ( kt, knt ) ! mesozooplankton 99 ENDIF 100 ! 101 CALL p4z_agg ( kt, knt ) ! Aggregation of particles 102 CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe 103 CALL p4z_poc ( kt, knt ) ! Remineralization of organic particles 104 IF( ln_ligand ) THEN 105 CALL p4z_ligand( kt, knt ) 106 ENDIF 87 107 ! ! 88 108 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 96 116 END SUBROUTINE p4z_bio 97 117 98 #else99 !!======================================================================100 !! Dummy module : No PISCES bio-model101 !!======================================================================102 CONTAINS103 SUBROUTINE p4z_bio ! Empty routine104 END SUBROUTINE p4z_bio105 #endif106 107 118 !!====================================================================== 108 119 END MODULE p4zbio -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6945 r7403 11 11 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 12 12 !! ! 2011-02 (J. Simeon, J.Orr ) update O2 solubility constants 13 !!---------------------------------------------------------------------- 14 #if defined key_pisces 15 !!---------------------------------------------------------------------- 16 !! 'key_pisces' PISCES bio-model 13 !! 3.6 ! 2016-03 (O. Aumont) Change chemistry to MOCSY standards 17 14 !!---------------------------------------------------------------------- 18 15 !! p4z_che : Sea water chemistry computed following OCMIP protocol … … 22 19 USE sms_pisces ! PISCES Source Minus Sink variables 23 20 USE lib_mpp ! MPP library 21 USE eosbn2, ONLY : neos 24 22 25 23 IMPLICIT NONE 26 24 PRIVATE 27 25 28 PUBLIC p4z_che ! 29 PUBLIC p4z_che_alloc ! 30 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq ! chemistry of Si 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq ! chemistry of Fe 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemo2 ! Solubilities of O2 and CO2 26 PUBLIC p4z_che ! 27 PUBLIC p4z_che_alloc ! 28 PUBLIC ahini_for_at ! 29 PUBLIC solve_at_general ! 30 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq ! chemistry of Si 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq ! chemistry of Fe 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemo2 ! Solubilities of O2 and CO2 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol ! solubility of Fe 35 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: salinprac ! Practical salinity 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ??? 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akf3 !: ??? 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aks3 !: ??? 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak1p3 !: ??? 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak2p3 !: ??? 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak3p3 !: ??? 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksi3 !: ??? 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fluorid !: ??? 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfat !: ??? 50 51 !!* Variable for chemistry of the CO2 cycle 36 52 37 53 REAL(wp), PUBLIC :: atcox = 0.20946 ! units atm 38 54 39 REAL(wp) :: salchl = 1. / 1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)40 55 REAL(wp) :: o2atm = 1. / ( 1000. * 0.20946 ) 41 56 42 REAL(wp) :: rgas = 83.14472 ! universal gas constants 43 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 44 45 REAL(wp) :: bor1 = 0.00023 ! borat constants 46 REAL(wp) :: bor2 = 1. / 10.82 47 48 REAL(wp) :: st1 = 0.14 ! constants for calculate concentrations for sulfate 49 REAL(wp) :: st2 = 1./96.062 ! (Morris & Riley 1966) 50 51 REAL(wp) :: ft1 = 0.000067 ! constants for calculate concentrations for fluorides 52 REAL(wp) :: ft2 = 1./18.9984 ! (Dickson & Riley 1979 ) 53 54 ! ! volumetric solubility constants for o2 in ml/L 55 REAL(wp) :: ox0 = 2.00856 ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 56 REAL(wp) :: ox1 = 3.22400 ! corrects for moisture and fugacity, but not total atmospheric pressure 57 REAL(wp) :: ox2 = 3.99063 ! Original PISCES code noted this was a solubility, but 58 REAL(wp) :: ox3 = 4.80299 ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 59 REAL(wp) :: ox4 = 9.78188e-1 ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 60 REAL(wp) :: ox5 = 1.71069 ! and atcox = 0.20946 to add the 1/atm dimension. 61 REAL(wp) :: ox6 = -6.24097e-3 62 REAL(wp) :: ox7 = -6.93498e-3 63 REAL(wp) :: ox8 = -6.90358e-3 64 REAL(wp) :: ox9 = -4.29155e-3 65 REAL(wp) :: ox10 = -3.11680e-7 57 REAL(wp) :: rgas = 83.14472 ! universal gas constants 58 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 66 59 67 60 ! ! coeff. for seawater pressure correction : millero 95 68 61 ! ! AGRIF doesn't like the DATA instruction 69 REAL(wp) :: devk11 = -25.5 70 REAL(wp) :: devk12 = -15.82 71 REAL(wp) :: devk13 = -29.48 72 REAL(wp) :: devk14 = -25.60 73 REAL(wp) :: devk15 = -48.76 62 REAL(wp) :: devk10 = -25.5 63 REAL(wp) :: devk11 = -15.82 64 REAL(wp) :: devk12 = -29.48 65 REAL(wp) :: devk13 = -20.02 66 REAL(wp) :: devk14 = -18.03 67 REAL(wp) :: devk15 = -9.78 68 REAL(wp) :: devk16 = -48.76 69 REAL(wp) :: devk17 = -14.51 70 REAL(wp) :: devk18 = -23.12 71 REAL(wp) :: devk19 = -26.57 72 REAL(wp) :: devk110 = -29.48 74 73 ! 75 REAL(wp) :: devk21 = 0.1271 76 REAL(wp) :: devk22 = -0.0219 77 REAL(wp) :: devk23 = 0.1622 78 REAL(wp) :: devk24 = 0.2324 79 REAL(wp) :: devk25 = 0.5304 74 REAL(wp) :: devk20 = 0.1271 75 REAL(wp) :: devk21 = -0.0219 76 REAL(wp) :: devk22 = 0.1622 77 REAL(wp) :: devk23 = 0.1119 78 REAL(wp) :: devk24 = 0.0466 79 REAL(wp) :: devk25 = -0.0090 80 REAL(wp) :: devk26 = 0.5304 81 REAL(wp) :: devk27 = 0.1211 82 REAL(wp) :: devk28 = 0.1758 83 REAL(wp) :: devk29 = 0.2020 84 REAL(wp) :: devk210 = 0.1622 80 85 ! 86 REAL(wp) :: devk30 = 0. 81 87 REAL(wp) :: devk31 = 0. 82 REAL(wp) :: devk32 = 0. 83 REAL(wp) :: devk33 = 2.608E-3 84 REAL(wp) :: devk34 = -3.6246E-3 85 REAL(wp) :: devk35 = 0. 88 REAL(wp) :: devk32 = 2.608E-3 89 REAL(wp) :: devk33 = -1.409e-3 90 REAL(wp) :: devk34 = 0.316e-3 91 REAL(wp) :: devk35 = -0.942e-3 92 REAL(wp) :: devk36 = 0. 93 REAL(wp) :: devk37 = -0.321e-3 94 REAL(wp) :: devk38 = -2.647e-3 95 REAL(wp) :: devk39 = -3.042e-3 96 REAL(wp) :: devk310 = -2.6080e-3 86 97 ! 87 REAL(wp) :: devk41 = -3.08E-3 88 REAL(wp) :: devk42 = 1.13E-3 89 REAL(wp) :: devk43 = -2.84E-3 90 REAL(wp) :: devk44 = -5.13E-3 91 REAL(wp) :: devk45 = -11.76E-3 98 REAL(wp) :: devk40 = -3.08E-3 99 REAL(wp) :: devk41 = 1.13E-3 100 REAL(wp) :: devk42 = -2.84E-3 101 REAL(wp) :: devk43 = -5.13E-3 102 REAL(wp) :: devk44 = -4.53e-3 103 REAL(wp) :: devk45 = -3.91e-3 104 REAL(wp) :: devk46 = -11.76e-3 105 REAL(wp) :: devk47 = -2.67e-3 106 REAL(wp) :: devk48 = -5.15e-3 107 REAL(wp) :: devk49 = -4.08e-3 108 REAL(wp) :: devk410 = -2.84e-3 92 109 ! 93 REAL(wp) :: devk51 = 0.0877E-3 94 REAL(wp) :: devk52 = -0.1475E-3 95 REAL(wp) :: devk53 = 0. 96 REAL(wp) :: devk54 = 0.0794E-3 97 REAL(wp) :: devk55 = 0.3692E-3 110 REAL(wp) :: devk50 = 0.0877E-3 111 REAL(wp) :: devk51 = -0.1475E-3 112 REAL(wp) :: devk52 = 0. 113 REAL(wp) :: devk53 = 0.0794E-3 114 REAL(wp) :: devk54 = 0.09e-3 115 REAL(wp) :: devk55 = 0.054e-3 116 REAL(wp) :: devk56 = 0.3692E-3 117 REAL(wp) :: devk57 = 0.0427e-3 118 REAL(wp) :: devk58 = 0.09e-3 119 REAL(wp) :: devk59 = 0.0714e-3 120 REAL(wp) :: devk510 = 0.0 121 ! 122 ! General parameters 123 REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 124 REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp 125 126 ! Maximum number of iterations for each method 127 INTEGER, PARAMETER :: jp_maxniter_atgen = 20 128 129 ! Bookkeeping variables for each method 130 ! - SOLVE_AT_GENERAL 131 INTEGER :: niter_atgen = jp_maxniter_atgen 98 132 99 133 !!---------------------------------------------------------------------- … … 113 147 !!--------------------------------------------------------------------- 114 148 INTEGER :: ji, jj, jk 115 REAL(wp) :: ztkel, zt , zt2, zsal , zsal2 , zbuf1 , zbuf2149 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 116 150 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 117 151 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 118 152 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 119 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1 153 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1, za2 120 154 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 155 REAL(wp) :: zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 121 156 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 157 REAL(wp) :: total2free, free2SWS, total2SWS, SWS2total 158 122 159 !!--------------------------------------------------------------------- 123 160 ! 124 161 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 162 ! 163 ! Computation of chemical constants require practical salinity 164 ! Thus, when TEOS08 is used, absolute salinity is converted to 165 ! practical salinity 166 ! ------------------------------------------------------------- 167 IF (neos == -1) THEN 168 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 169 ELSE 170 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 171 ENDIF 172 125 173 ! 126 174 ! Computations of chemical constants require in situ temperature … … 133 181 DO ji = 1, jpi 134 182 zpres = gdept_n(ji,jj,jk) / 1000. 135 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * ( tsn(ji,jj,jk,jp_sal) - 35.0) )183 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 136 184 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 137 185 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 … … 142 190 ! CHEMICAL CONSTANTS - SURFACE LAYER 143 191 ! ---------------------------------- 192 !CDIR NOVERRCHK 144 193 DO jj = 1, jpj 194 !CDIR NOVERRCHK 145 195 DO ji = 1, jpi 146 196 ! ! SET ABSOLUTE TEMPERATURE 147 197 ztkel = tempis(ji,jj,1) + 273.15 148 198 zt = ztkel * 0.01 149 zt2 = zt * zt 150 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 151 zsal2 = zsal * zsal 152 zlogt = LOG( zt ) 199 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 153 200 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 154 201 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 155 202 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 156 203 & + 0.0047036e-4*ztkel**2) 157 ! ! SET SOLUBILITIES OF O2 AND CO2 158 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 204 chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 159 205 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 160 206 chemc(ji,jj,3) = 57.7 - 0.118*ztkel … … 165 211 ! OXYGEN SOLUBILITY - DEEP OCEAN 166 212 ! ------------------------------- 213 !CDIR NOVERRCHK 167 214 DO jk = 1, jpk 215 !CDIR NOVERRCHK 168 216 DO jj = 1, jpj 217 !CDIR NOVERRCHK 169 218 DO ji = 1, jpi 170 219 ztkel = tempis(ji,jj,jk) + 273.15 171 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.220 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 172 221 zsal2 = zsal * zsal 173 222 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature … … 176 225 ztgg4 = ztgg3 * ztgg 177 226 ztgg5 = ztgg4 * ztgg 178 zoxy = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5 & 179 + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) + ox10 * zsal2 227 228 zoxy = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3 & 229 & + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3 & 230 & - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 ) & 231 & - 3.11680e-7 * zsal2 180 232 chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox ! mol/(L atm) 181 233 END DO … … 187 239 ! CHEMICAL CONSTANTS - DEEP OCEAN 188 240 ! ------------------------------- 241 !CDIR NOVERRCHK 189 242 DO jk = 1, jpk 243 !CDIR NOVERRCHK 190 244 DO jj = 1, jpj 245 !CDIR NOVERRCHK 191 246 DO ji = 1, jpi 192 247 … … 199 254 ! SET ABSOLUTE TEMPERATURE 200 255 ztkel = tempis(ji,jj,jk) + 273.15 201 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.256 zsal = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 202 257 zsqrt = SQRT( zsal ) 203 258 zsal15 = zsqrt * zsal … … 210 265 211 266 ! CHLORINITY (WOOSTER ET AL., 1969) 212 zcl = zsal * salchl267 zcl = zsal / 1.80655 213 268 214 269 ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 215 zst = st1 * zcl * st2270 zst = 0.14 * zcl /96.062 216 271 217 272 ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 218 zft = ft1 * zcl * ft2273 zft = 0.000067 * zcl /18.9984 219 274 220 275 ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) … … 224 279 & - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2 & 225 280 & + LOG(1.0 - 0.001005 * zsal)) 226 !227 aphscale(ji,jj,jk) = ( 1. + zst / zcks )228 281 229 282 ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) … … 239 292 & * zlogt + 0.053105*zsqrt*ztkel 240 293 241 242 294 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 243 295 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale … … 247 299 - 0.01781*zsal + 0.0001122*zsal*zsal) 248 300 249 ! PKW (H2O) (DICKSON AND RILEY, 1979) 250 zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt & 251 & + (118.67*ztr - 5.977 + 1.0495 * zlogt) & 252 & * zsqrt - 0.01615 * zsal 301 ! PKW (H2O) (MILLERO, 1995) from composite data 302 zckw = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr & 303 - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 304 305 ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 306 zck1p = -4576.752*ztr + 115.540 - 18.453*zlogt & 307 & + (-106.736*ztr + 0.69171) * zsqrt & 308 & + (-0.65643*ztr - 0.01844) * zsal 309 310 zck2p = -8814.715*ztr + 172.1033 - 27.927*zlogt & 311 & + (-160.340*ztr + 1.3566)*zsqrt & 312 & + (0.37335*ztr - 0.05778)*zsal 313 314 zck3p = -3070.75*ztr - 18.126 & 315 & + (17.27039*ztr + 2.81197) * zsqrt & 316 & + (-44.99486*ztr - 0.09984) * zsal 317 318 ! CONSTANT FOR SILICATE, MILLERO (1995) 319 zcksi = -8904.2*ztr + 117.400 - 19.334*zlogt & 320 & + (-458.79*ztr + 3.5913) * zisqrt & 321 & + (188.74*ztr - 1.5998) * zis & 322 & + (-12.1652*ztr + 0.07871) * zis2 & 323 & + LOG(1.0 - 0.001005*zsal) 253 324 254 325 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER … … 258 329 & - 0.07711*zsal + 0.0041249*zsal15 259 330 331 ! CONVERT FROM DIFFERENT PH SCALES 332 total2free = 1.0/(1.0 + zst/zcks) 333 free2SWS = 1. + zst/zcks + zft/(zckf*total2free) 334 total2SWS = total2free * free2SWS 335 SWS2total = 1.0 / total2SWS 336 260 337 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 261 zak1 = 10**(zck1) 262 zak2 = 10**(zck2) 263 zakb = EXP( zckb )338 zak1 = 10**(zck1) * total2SWS 339 zak2 = 10**(zck2) * total2SWS 340 zakb = EXP( zckb ) * total2SWS 264 341 zakw = EXP( zckw ) 265 342 zaksp1 = 10**(zaksp0) 343 zak1p = exp( zck1p ) 344 zak2p = exp( zck2p ) 345 zak3p = exp( zck3p ) 346 zaksi = exp( zcksi ) 347 zckf = zckf * total2SWS 266 348 267 349 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) … … 275 357 ! FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 276 358 ! SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 277 zcpexp = zpres / (rgas*ztkel)278 zcpexp2 = zpres * z pres/(rgas*ztkel)359 zcpexp = zpres / (rgas*ztkel) 360 zcpexp2 = zpres * zcpexp 279 361 280 362 ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE … … 282 364 ! (CF. BROECKER ET AL., 1982) 283 365 284 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 366 zbuf1 = - ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 367 zbuf2 = 0.5 * ( devk40 + devk50 * ztc ) 368 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 369 370 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 285 371 zbuf2 = 0.5 * ( devk41 + devk51 * ztc ) 286 ak 13(ji,jj,jk) = zak1* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )372 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 287 373 288 374 zbuf1 = - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 289 375 zbuf2 = 0.5 * ( devk42 + devk52 * ztc ) 290 ak 23(ji,jj,jk) = zak2* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )376 akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 291 377 292 378 zbuf1 = - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 293 379 zbuf2 = 0.5 * ( devk43 + devk53 * ztc ) 294 ak b3(ji,jj,jk) = zakb* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )380 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 295 381 296 382 zbuf1 = - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 297 383 zbuf2 = 0.5 * ( devk44 + devk54 * ztc ) 298 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 299 384 aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 385 386 zbuf1 = - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 387 zbuf2 = 0.5 * ( devk45 + devk55 * ztc ) 388 akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 389 390 zbuf1 = - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 391 zbuf2 = 0.5 * ( devk47 + devk57 * ztc ) 392 ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 393 394 zbuf1 = - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 395 zbuf2 = 0.5 * ( devk48 + devk58 * ztc ) 396 ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 397 398 zbuf1 = - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 399 zbuf2 = 0.5 * ( devk49 + devk59 * ztc ) 400 ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 401 402 zbuf1 = - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 403 zbuf2 = 0.5 * ( devk410 + devk510 * ztc ) 404 aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 405 406 ! CONVERT FROM DIFFERENT PH SCALES 407 total2free = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 408 free2SWS = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 409 total2SWS = total2free * free2SWS 410 SWS2total = 1.0 / total2SWS 411 412 ! Convert to total scale 413 ak13(ji,jj,jk) = ak13(ji,jj,jk) * SWS2total 414 ak23(ji,jj,jk) = ak23(ji,jj,jk) * SWS2total 415 akb3(ji,jj,jk) = akb3(ji,jj,jk) * SWS2total 416 akw3(ji,jj,jk) = akw3(ji,jj,jk) * SWS2total 417 ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 418 ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 419 ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 420 aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 421 akf3(ji,jj,jk) = akf3(ji,jj,jk) / total2free 300 422 301 423 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 302 424 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 303 425 ! (P. 1285) AND BERNER (1976) 304 zbuf1 = - ( devk1 5 + devk25 * ztc + devk35* ztc * ztc )305 zbuf2 = 0.5 * ( devk4 5 + devk55* ztc )426 zbuf1 = - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 427 zbuf2 = 0.5 * ( devk46 + devk56 * ztc ) 306 428 aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 307 429 308 ! TOTAL BORATE CONCENTR. [MOLES/L] 309 borat(ji,jj,jk) = bor1 * zcl * bor2 430 ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 431 borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 432 sulfat(ji,jj,jk) = zst 433 fluorid(ji,jj,jk) = zft 310 434 311 435 ! Iron and SIO3 saturation concentration from ... 312 436 sio3eq(ji,jj,jk) = EXP( LOG( 10.) * ( 6.44 - 968. / ztkel ) ) * 1.e-6 313 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) ) 314 437 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 438 439 ! Liu and Millero (1999) only valid 5 - 50 degC 440 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 441 fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 442 fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 443 fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 444 fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 445 fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 315 446 END DO 316 447 END DO … … 321 452 END SUBROUTINE p4z_che 322 453 454 SUBROUTINE ahini_for_at(p_hini) 455 !!--------------------------------------------------------------------- 456 !! *** ROUTINE ahini_for_at *** 457 !! 458 !! Subroutine returns the root for the 2nd order approximation of the 459 !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic 460 !! polynomial) around the local minimum, if it exists. 461 !! Returns * 1E-03_wp if p_alkcb <= 0 462 !! * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 463 !! * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 464 !! and the 2nd order approximation does not have 465 !! a solution 466 !!--------------------------------------------------------------------- 467 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini 468 INTEGER :: ji, jj, jk 469 REAL(wp) :: zca1, zba1 470 REAL(wp) :: zd, zsqrtd, zhmin 471 REAL(wp) :: za2, za1, za0 472 REAL(wp) :: p_dictot, p_bortot, p_alkcb 473 474 IF( nn_timing == 1 ) CALL timing_start('ahini_for_at') 475 ! 476 DO jk = 1, jpk 477 DO jj = 1, jpj 478 DO ji = 1, jpi 479 p_alkcb = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 480 p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 481 p_bortot = borat(ji,jj,jk) 482 IF (p_alkcb <= 0.) THEN 483 p_hini(ji,jj,jk) = 1.e-3 484 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 485 p_hini(ji,jj,jk) = 1.e-10_wp 486 ELSE 487 zca1 = p_dictot/( p_alkcb + rtrn ) 488 zba1 = p_bortot/ (p_alkcb + rtrn ) 489 ! Coefficients of the cubic polynomial 490 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 491 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1) & 492 & + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 493 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 494 ! Taylor expansion around the minimum 495 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 496 ! for the minimum close to the root 497 498 IF(zd > 0.) THEN ! If the discriminant is positive 499 zsqrtd = SQRT(zd) 500 IF(za2 < 0) THEN 501 zhmin = (-za2 + zsqrtd)/3. 502 ELSE 503 zhmin = -za1/(za2 + zsqrtd) 504 ENDIF 505 p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 506 ELSE 507 p_hini(ji,jj,jk) = 1.e-7 508 ENDIF 509 ! 510 ENDIF 511 END DO 512 END DO 513 END DO 514 ! 515 IF( nn_timing == 1 ) CALL timing_stop('ahini_for_at') 516 ! 517 END SUBROUTINE ahini_for_at 518 519 !=============================================================================== 520 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 521 522 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 523 ! contributions to total alkalinity (the infimum and the supremum), i.e 524 ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 525 526 ! Argument variables 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 528 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 529 530 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 531 & - fluorid(:,:,:) 532 p_alknw_sup(:,:,:) = (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) & 533 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 534 535 END SUBROUTINE anw_infsup 536 537 538 SUBROUTINE solve_at_general( p_hini, zhi ) 539 540 ! Universal pH solver that converges from any given initial value, 541 ! determines upper an lower bounds for the solution if required 542 543 ! Argument variables 544 !-------------------- 545 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini 546 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi 547 548 ! Local variables 549 !----------------- 550 INTEGER :: ji, jj, jk, jn 551 REAL(wp) :: zh_ini, zh, zh_prev, zh_lnfactor 552 REAL(wp) :: zdelta, zh_delta 553 REAL(wp) :: zeqn, zdeqndh, zalka 554 REAL(wp) :: aphscale 555 REAL(wp) :: znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 556 REAL(wp) :: znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 557 REAL(wp) :: znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 558 REAL(wp) :: znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 559 REAL(wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 560 REAL(wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 561 REAL(wp) :: zalk_wat, zdalk_wat 562 REAL(wp) :: zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 563 LOGICAL :: l_exitnow 564 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 565 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 566 567 IF( nn_timing == 1 ) CALL timing_start('solve_at_general') 568 ! Allocate temporary workspace 569 CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 570 CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 571 572 CALL anw_infsup( zalknw_inf, zalknw_sup ) 573 574 rmask(:,:,:) = tmask(:,:,:) 575 zhi(:,:,:) = 0. 576 577 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 578 DO jk = 1, jpk 579 DO jj = 1, jpj 580 DO ji = 1, jpi 581 IF (rmask(ji,jj,jk) == 1.) THEN 582 p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 583 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 584 zh_ini = p_hini(ji,jj,jk) 585 586 zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 587 588 IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 589 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 590 ELSE 591 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 592 ENDIF 593 594 zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 595 596 IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 597 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 598 ELSE 599 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 600 ENDIF 601 602 zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 603 ENDIF 604 END DO 605 END DO 606 END DO 607 608 zeqn_absmin(:,:,:) = HUGE(1._wp) 609 610 DO jn = 1, jp_maxniter_atgen 611 DO jk = 1, jpk 612 DO jj = 1, jpj 613 DO ji = 1, jpi 614 IF (rmask(ji,jj,jk) == 1.) THEN 615 zfact = rhop(ji,jj,jk) / 1000. + rtrn 616 p_alktot = trb(ji,jj,jk,jptal) / zfact 617 zdic = trb(ji,jj,jk,jpdic) / zfact 618 zbot = borat(ji,jj,jk) 619 zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 620 zsit = trb(ji,jj,jk,jpsil) / zfact 621 zst = sulfat (ji,jj,jk) 622 zft = fluorid(ji,jj,jk) 623 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 624 zh = zhi(ji,jj,jk) 625 zh_prev = zh 626 627 ! H2CO3 - HCO3 - CO3 : n=2, m=0 628 znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 629 zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 630 zalk_dic = zdic * (znumer_dic/zdenom_dic) 631 zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh & 632 *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 633 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 634 635 636 ! B(OH)3 - B(OH)4 : n=1, m=0 637 znumer_bor = akb3(ji,jj,jk) 638 zdenom_bor = akb3(ji,jj,jk) + zh 639 zalk_bor = zbot * (znumer_bor/zdenom_bor) 640 zdnumer_bor = akb3(ji,jj,jk) 641 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 642 643 644 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 645 znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 646 & + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 647 zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 648 & + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 649 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 650 zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 651 & + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 652 & + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 653 & + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) & 654 & + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 655 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 656 657 ! H4SiO4 - H3SiO4 : n=1, m=0 658 znumer_sil = aksi3(ji,jj,jk) 659 zdenom_sil = aksi3(ji,jj,jk) + zh 660 zalk_sil = zsit * (znumer_sil/zdenom_sil) 661 zdnumer_sil = aksi3(ji,jj,jk) 662 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 663 664 ! HSO4 - SO4 : n=1, m=1 665 aphscale = 1.0 + zst/aks3(ji,jj,jk) 666 znumer_so4 = aks3(ji,jj,jk) * aphscale 667 zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 668 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 669 zdnumer_so4 = aks3(ji,jj,jk) 670 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 671 672 ! HF - F : n=1, m=1 673 znumer_flu = akf3(ji,jj,jk) 674 zdenom_flu = akf3(ji,jj,jk) + zh 675 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 676 zdnumer_flu = akf3(ji,jj,jk) 677 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 678 679 ! H2O - OH 680 aphscale = 1.0 + zst/aks3(ji,jj,jk) 681 zalk_wat = akw3(ji,jj,jk)/zh - zh/aphscale 682 zdalk_wat = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 683 684 ! CALCULATE [ALK]([CO3--], [HCO3-]) 685 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 686 & + zalk_so4 + zalk_flu & 687 & + zalk_wat - p_alktot 688 689 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 690 & + zalk_so4 + zalk_flu + zalk_wat) 691 692 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 693 & + zdalk_so4 + zdalk_flu + zdalk_wat 694 695 ! Adapt bracketing interval 696 IF(zeqn > 0._wp) THEN 697 zh_min(ji,jj,jk) = zh_prev 698 ELSEIF(zeqn < 0._wp) THEN 699 zh_max(ji,jj,jk) = zh_prev 700 ENDIF 701 702 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 703 ! if the function evaluation at the current point is 704 ! not decreasing faster than with a bisection step (at least linearly) 705 ! in absolute value take one bisection step on [ph_min, ph_max] 706 ! ph_new = (ph_min + ph_max)/2d0 707 ! 708 ! In terms of [H]_new: 709 ! [H]_new = 10**(-ph_new) 710 ! = 10**(-(ph_min + ph_max)/2d0) 711 ! = SQRT(10**(-(ph_min + phmax))) 712 ! = SQRT(zh_max * zh_min) 713 zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 714 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 715 ELSE 716 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 717 ! = -zdeqndh * LOG(10) * [H] 718 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 719 ! 720 ! pH_new = pH_old + \deltapH 721 ! 722 ! [H]_new = 10**(-pH_new) 723 ! = 10**(-pH_old - \Delta pH) 724 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 725 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 726 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 727 728 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 729 730 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 731 zh = zh_prev*EXP(zh_lnfactor) 732 ELSE 733 zh_delta = zh_lnfactor*zh_prev 734 zh = zh_prev + zh_delta 735 ENDIF 736 737 IF( zh < zh_min(ji,jj,jk) ) THEN 738 ! if [H]_new < [H]_min 739 ! i.e., if ph_new > ph_max then 740 ! take one bisection step on [ph_prev, ph_max] 741 ! ph_new = (ph_prev + ph_max)/2d0 742 ! In terms of [H]_new: 743 ! [H]_new = 10**(-ph_new) 744 ! = 10**(-(ph_prev + ph_max)/2d0) 745 ! = SQRT(10**(-(ph_prev + phmax))) 746 ! = SQRT([H]_old*10**(-ph_max)) 747 ! = SQRT([H]_old * zh_min) 748 zh = SQRT(zh_prev * zh_min(ji,jj,jk)) 749 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 750 ENDIF 751 752 IF( zh > zh_max(ji,jj,jk) ) THEN 753 ! if [H]_new > [H]_max 754 ! i.e., if ph_new < ph_min, then 755 ! take one bisection step on [ph_min, ph_prev] 756 ! ph_new = (ph_prev + ph_min)/2d0 757 ! In terms of [H]_new: 758 ! [H]_new = 10**(-ph_new) 759 ! = 10**(-(ph_prev + ph_min)/2d0) 760 ! = SQRT(10**(-(ph_prev + ph_min))) 761 ! = SQRT([H]_old*10**(-ph_min)) 762 ! = SQRT([H]_old * zhmax) 763 zh = SQRT(zh_prev * zh_max(ji,jj,jk)) 764 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 765 ENDIF 766 ENDIF 767 768 zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 769 770 ! Stop iterations once |\delta{[H]}/[H]| < rdel 771 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 772 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 773 774 ! Alternatively: 775 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 776 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 777 ! < 1/LOG(10) * rdel 778 779 ! Hence |zeqn/(zdeqndh*zh)| < rdel 780 781 ! rdel <-- pp_rdel_ah_target 782 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 783 784 IF(l_exitnow) THEN 785 rmask(ji,jj,jk) = 0. 786 ENDIF 787 788 zhi(ji,jj,jk) = zh 789 790 IF(jn >= jp_maxniter_atgen) THEN 791 zhi(ji,jj,jk) = -1._wp 792 ENDIF 793 794 ENDIF 795 END DO 796 END DO 797 END DO 798 END DO 799 ! 800 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 801 CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 802 803 804 IF( nn_timing == 1 ) CALL timing_stop('solve_at_general') 805 806 807 END SUBROUTINE solve_at_general 323 808 324 809 INTEGER FUNCTION p4z_che_alloc() … … 326 811 !! *** ROUTINE p4z_che_alloc *** 327 812 !!---------------------------------------------------------------------- 328 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), & 329 & tempis(jpi,jpj,jpk), STAT=p4z_che_alloc ) 813 INTEGER :: ierr(3) ! Local variables 814 !!---------------------------------------------------------------------- 815 816 ierr(:) = 0 817 818 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) 819 820 ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi, jpj, jpk), & 821 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 822 & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , & 823 & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , & 824 & ak3p3(jpi,jpj,jpk) , aksi3(jpi,jpj,jpk) , & 825 & fluorid(jpi,jpj,jpk) , sulfat(jpi,jpj,jpk) , & 826 & salinprac(jpi,jpj,jpk), STAT=ierr(2) ) 827 828 ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) ) 829 830 !* Variable for chemistry of the CO2 cycle 831 p4z_che_alloc = MAXVAL( ierr ) 330 832 ! 331 833 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') … … 333 835 END FUNCTION p4z_che_alloc 334 836 335 #else336 837 !!====================================================================== 337 !! Dummy module : No PISCES bio-model 338 !!====================================================================== 339 CONTAINS 340 SUBROUTINE p4z_che( kt ) ! Empty routine 341 INTEGER, INTENT(in) :: kt 342 WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 343 END SUBROUTINE p4z_che 344 #endif 345 346 !!====================================================================== 347 END MODULE p4zche 838 END MODULE p4zche -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r6140 r7403 5 5 !!====================================================================== 6 6 !! History : 3.5 ! 2012-07 (O. Aumont, A. Tagliabue, C. Ethe) Original code 7 !!---------------------------------------------------------------------- 8 #if defined key_pisces 9 !!---------------------------------------------------------------------- 10 !! 'key_top' and TOP models 11 !! 'key_pisces' PISCES bio-model 7 !! 3.6 ! 2015-05 (O. Aumont) PISCES quota 12 8 !!---------------------------------------------------------------------- 13 9 !! p4z_fechem : Compute remineralization/scavenging of iron … … 18 14 USE trc ! passive tracers common variables 19 15 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zopt ! optical model21 16 USE p4zche ! chemical model 22 17 USE p4zsbc ! Boundary conditions from sediments … … 30 25 PUBLIC p4z_fechem_init ! called in trcsms_pisces.F90 31 26 32 LOGICAL :: ln_fechem !: boolean for complex iron chemistry following Tagliabue and voelker 33 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker 34 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron 35 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust 36 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 37 38 !!gm Not DOCTOR norm !!! 27 !! * Shared module variables 28 LOGICAL :: ln_fechem !: boolean for complex iron chemistry following Tagliabue and voelker 29 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker 30 LOGICAL :: ln_fecolloid !: boolean for variable colloidal fraction 31 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron 32 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust 33 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 34 REAL(wp), PUBLIC :: kfep !: rate constant for nanoparticle formation 35 39 36 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 40 37 … … 59 56 !! and one particulate form (ln_fechem) 60 57 !!--------------------------------------------------------------------- 61 INTEGER, INTENT(in) :: kt, knt ! ocean time step62 !63 INTEGER :: ji, jj, jk, jic64 CHARACTER (len=25) :: charout58 ! 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step 60 ! 61 INTEGER :: ji, jj, jk, jic, jn 65 62 REAL(wp) :: zdep, zlam1a, zlam1b, zlamfac 66 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll 63 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll, fe3sol 67 64 REAL(wp) :: zdenom1, zscave, zaggdfea, zaggdfeb, zcoag 68 65 REAL(wp) :: ztrc, zdust 69 #if ! defined key_kriest 70 REAL(wp) :: zdenom, zdenom2 71 #endif 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 66 REAL(wp) :: zdenom2 67 REAL(wp) :: zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2 68 REAL(wp) :: zrum, zcodel, zargu, zlight 74 69 REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 75 70 REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 76 71 REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 77 REAL(wp) :: ztfe, zoxy 78 REAL(wp) :: zstep 72 REAL(wp) :: ztfe, zoxy, zhplus 73 REAL(wp) :: zaggliga, zaggligb 74 REAL(wp) :: dissol, zligco 75 CHARACTER (len=25) :: charout 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 78 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zstrn2 79 79 !!--------------------------------------------------------------------- 80 80 ! 81 81 IF( nn_timing == 1 ) CALL timing_start('p4z_fechem') 82 82 ! 83 CALL wrk_alloc( jpi,jpj,jpk, zFe3, zFeL1, zTL1, ztotlig ) 83 ! Allocate temporary workspace 84 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 84 85 zFe3 (:,:,:) = 0. 85 86 zFeL1(:,:,:) = 0. 86 87 zTL1 (:,:,:) = 0. 87 88 IF( ln_fechem ) THEN 88 CALL wrk_alloc( jpi,jpj,jpk, zFe2, zFeL2, zTL2, zFeP ) 89 CALL wrk_alloc( jpi, jpj, zstrn, zstrn2 ) 90 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 89 91 zFe2 (:,:,:) = 0. 90 92 zFeL2(:,:,:) = 0. … … 100 102 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 101 103 ELSE 102 ztotlig(:,:,:) = ligand * 1E9 104 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 105 ELSE ; ztotlig(:,:,:) = ligand * 1E9 106 ENDIF 103 107 ENDIF 104 108 105 109 IF( ln_fechem ) THEN 110 ! compute the day length depending on latitude and the day 111 zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 112 zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) ) 113 114 ! day length in hours 115 zstrn(:,:) = 0. 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 119 zargu = MAX( -1., MIN( 1., zargu ) ) 120 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 121 END DO 122 END DO 123 124 ! Maximum light intensity 125 zstrn2(:,:) = zstrn(:,:) / 24. 126 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 127 zstrn(:,:) = 24. / zstrn(:,:) 128 106 129 ! ------------------------------------------------------------ 107 130 ! NEW FE CHEMISTRY ROUTINE from Tagliabue and Volker (2009) … … 109 132 ! Chemistry is supposed to be fast enough to be at equilibrium 110 133 ! ------------------------------------------------------------ 111 DO jk = 1, jpkm1 134 DO jn = 1, 2 135 DO jk = 1, jpkm1 112 136 DO jj = 1, jpj 113 137 DO ji = 1, jpi 138 zlight = etot(ji,jj,jk) * zstrn(ji,jj) * REAL( 2-jn, wp ) 139 zzstrn2 = zstrn2(ji,jj) * REAL( 2-jn, wp ) + (1. - zstrn2(ji,jj) ) * REAL( jn-1, wp ) 114 140 ! Calculate ligand concentrations : assume 2/3rd of excess goes to 115 141 ! strong ligands (L1) and 1/3rd to weak ligands (L2) … … 118 144 zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand 119 145 ! ionic strength from Millero et al. 1987 120 zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )121 146 zph = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 122 zoxy = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )147 zoxy = trb(ji,jj,jk,jpoxy) 123 148 ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 124 zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( t sn(ji,jj,jk,jp_tem) + 273.15 ) &125 & - 0.04406 * SQRT( tsn(ji,jj,jk,jp_sal) ) - 0.002847 * tsn(ji,jj,jk,jp_sal)149 zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 ) & 150 & - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk) 126 151 zkox = ( 10.** zkox ) * spd 127 152 zkox = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn ) 128 153 ! PHOTOREDUCTION of complexed iron : Tagliabue and Arrigo (2006) 129 zkph2 = MAX( 0., 15. * etot(ji,jj,jk) / ( etot(ji,jj,jk) + 2. ))154 zkph2 = MAX( 0., 15. * zlight / ( zlight + 2. ) ) * (1. - fr_i(ji,jj)) 130 155 zkph1 = zkph2 / 5. 131 156 ! pass the dfe concentration from PISCES … … 167 192 zphi = ACOS( zfff ) 168 193 DO jic = 1, 3 169 zfunc = -2 * zr * COS( zphi / 3. + 2. * FLOAT( jic - 1) * rpi / 3. ) - za2 / 3.194 zfunc = -2 * zr * COS( zphi / 3. + 2. * REAL( jic - 1, wp ) * rpi / 3. ) - za2 / 3. 170 195 IF( zfunc > 0. .AND. zfunc <= ztfe) zxs = zfunc 171 196 END DO … … 173 198 ENDIF 174 199 ! solve for the other Fe species 175 z Fe3(ji,jj,jk) = MAX( 0., zxs )176 z Fep(ji,jj,jk) = MAX( 0., ( ks * zFe3(ji,jj,jk)/ kpr ) )200 zzFe3 = MAX( 0., zxs ) 201 zzFep = MAX( 0., ( ks * zzFe3 / kpr ) ) 177 202 zkappa2 = ( kb2 + zkph2 ) / kl2 178 zFeL2(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * zTL2(ji,jj,jk) ) / ( zkappa2 + zFe3(ji,jj,jk) ) ) 179 zFeL1(ji,jj,jk) = MAX( 0., ( ztfe / zb - za / zb * zFe3(ji,jj,jk) - zc / zb * zFeL2(ji,jj,jk) ) ) 180 zFe2 (ji,jj,jk) = MAX( 0., ( ( zkph1 * zFeL1(ji,jj,jk) + zkph2 * zFeL2(ji,jj,jk) ) / zkox ) ) 203 zzFeL2 = MAX( 0., ( zzFe3 * zTL2(ji,jj,jk) ) / ( zkappa2 + zzFe3 ) ) 204 zzFeL1 = MAX( 0., ( ztfe / zb - za / zb * zzFe3 - zc / zb * zzFeL2 ) ) 205 zzFe2 = MAX( 0., ( ( zkph1 * zzFeL1 + zkph2 * zzFeL2 ) / zkox ) ) 206 zFe3(ji,jj,jk) = zFe3(ji,jj,jk) + zzFe3 * zzstrn2 207 zFe2(ji,jj,jk) = zFe2(ji,jj,jk) + zzFe2 * zzstrn2 208 zFeL2(ji,jj,jk) = zFeL2(ji,jj,jk) + zzFeL2 * zzstrn2 209 zFeL1(ji,jj,jk) = zFeL1(ji,jj,jk) + zzFeL1 * zzstrn2 210 zFeP(ji,jj,jk) = zFeP(ji,jj,jk) + zzFeP * zzstrn2 181 211 END DO 182 212 END DO 213 END DO 183 214 END DO 184 215 ELSE … … 206 237 ! 207 238 ENDIF 208 ! 239 209 240 zdust = 0. ! if no dust available 210 !211 241 DO jk = 1, jpkm1 212 242 DO jj = 1, jpj 213 243 DO ji = 1, jpi 214 zstep = xstep215 # if defined key_degrad216 zstep = zstep * facvol(ji,jj,jk)217 # endif218 244 ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 219 245 ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). … … 224 250 zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9 225 251 ELSE 226 zfeequi = zFe3(ji,jj,jk) * 1E-9 227 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 252 zfeequi = zFe3(ji,jj,jk) * 1E-9 253 IF (ln_fecolloid) THEN 254 zhplus = max( rtrn, hi(ji,jj,jk) ) 255 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 256 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 257 & + fesol(ji,jj,jk,5) / zhplus ) 258 zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) ) 259 ELSE 260 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 261 fe3sol = 0. 262 ENDIF 228 263 ENDIF 229 #if defined key_kriest 230 ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 231 #else 264 ! 232 265 ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 233 #endif234 266 IF( ln_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 235 267 zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc 236 zscave = zfeequi * zlam1b * zstep268 zscave = zfeequi * zlam1b * xstep 237 269 238 270 ! Compute the different ratios for scavenging of iron … … 240 272 ! --------------------------------------------------------- 241 273 zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b 242 #if ! defined key_kriest243 274 zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b 244 #endif245 275 246 276 ! Increased scavenging for very high iron concentrations found near the coasts … … 249 279 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 250 280 zlamfac = MIN( 1. , zlamfac ) 251 !!gm very small BUG : it is unlikely but possible that gdept_n = 0 .....252 281 zdep = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 253 282 zlam1b = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 254 zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)283 zcoag = zfeequi * zlam1b * xstep + 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 255 284 256 285 ! Compute the coagulation of colloidal iron. This parameterization … … 259 288 ! ---------------------------------------------------------------- 260 289 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 261 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) ) 262 zaggdfea = zlam1a * zstep * zfecoll 263 #if defined key_kriest 264 zaggdfeb = 0. 290 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) 291 zaggdfea = zlam1a * xstep * zfecoll 265 292 ! 266 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag267 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb268 #else269 293 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 270 zaggdfeb = zlam1b * zstep * zfecoll294 zaggdfeb = zlam1b * xstep * zfecoll 271 295 ! 272 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 296 ! precipitation of Fe3+, creation of nanoparticles 297 precip(ji,jj,jk) = MAX( 0., ( zfeequi - fe3sol ) ) * kfep * xstep 298 ! 299 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 300 & - zcoag - precip(ji,jj,jk) 273 301 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 274 302 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 275 #endif 303 ! 276 304 END DO 277 305 END DO … … 280 308 ! Define the bioavailable fraction of iron 281 309 ! ---------------------------------------- 282 IF( ln_fechem ) THEN 283 biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 284 ELSE 285 biron(:,:,:) = trb(:,:,:,jpfer) 286 ENDIF 287 310 IF( ln_fechem ) THEN ; biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 311 ELSE ; biron(:,:,:) = trb(:,:,:,jpfer) 312 ENDIF 313 ! 314 IF( ln_ligand ) THEN 315 ! 316 DO jk = 1, jpkm1 317 DO jj = 1, jpj 318 DO ji = 1, jpi 319 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 320 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) 321 ! 322 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 323 zligco = MAX( ( 0.1 * trb(ji,jj,jk,jplgw) ), ( trb(ji,jj,jk,jplgw) - fe3sol ) ) 324 zaggliga = zlam1a * xstep * zligco 325 zaggligb = zlam1b * xstep * zligco 326 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk) 327 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 328 END DO 329 END DO 330 END DO 331 ! 332 IF( .NOT.ln_fechem) THEN 333 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 334 plig(:,:,:) = MAX( 0. , plig(:,:,:) ) 335 ENDIF 336 ! 337 ENDIF 288 338 ! Output of some diagnostics variables 289 339 ! --------------------------------- 290 IF( lk_iomput .AND. knt == nrdttrc ) THEN 340 IF( lk_iomput ) THEN 341 IF( knt == nrdttrc ) THEN 291 342 IF( iom_use("Fe3") ) CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+ 292 343 IF( iom_use("FeL1") ) CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1 … … 300 351 IF( iom_use("TL2") ) CALL iom_put("TL2" , zTL2 (:,:,:) * tmask(:,:,:) ) ! TL2 301 352 ENDIF 353 ENDIF 302 354 ENDIF 303 355 … … 308 360 ENDIF 309 361 ! 310 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 311 IF( ln_fechem ) CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 362 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 363 IF( ln_fechem ) THEN 364 CALL wrk_dealloc( jpi, jpj, zstrn, zstrn2 ) 365 CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 366 ENDIF 312 367 ! 313 368 IF( nn_timing == 1 ) CALL timing_stop('p4z_fechem') … … 328 383 !! 329 384 !!---------------------------------------------------------------------- 330 NAMELIST/nampisfer/ ln_fechem, ln_ligvar, xlam1, xlamdust, ligand385 NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep 331 386 INTEGER :: ios ! Local integer output status for namelist read 332 387 … … 344 399 WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer' 345 400 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 346 WRITE(numout,*) ' enable complex iron chemistry scheme ln_fechem =', ln_fechem 347 WRITE(numout,*) ' variable concentration of ligand ln_ligvar =', ln_ligvar 348 WRITE(numout,*) ' scavenging rate of Iron xlam1 =', xlam1 349 WRITE(numout,*) ' scavenging rate of Iron by dust xlamdust =', xlamdust 350 WRITE(numout,*) ' ligand concentration in the ocean ligand =', ligand 401 WRITE(numout,*) ' enable complex iron chemistry scheme ln_fechem =', ln_fechem 402 WRITE(numout,*) ' variable concentration of ligand ln_ligvar =', ln_ligvar 403 WRITE(numout,*) ' Variable colloidal fraction of Fe3+ ln_fecolloid =', ln_fecolloid 404 WRITE(numout,*) ' scavenging rate of Iron xlam1 =', xlam1 405 WRITE(numout,*) ' scavenging rate of Iron by dust xlamdust =', xlamdust 406 WRITE(numout,*) ' ligand concentration in the ocean ligand =', ligand 407 WRITE(numout,*) ' rate constant for nanoparticle formation kfep =', kfep 351 408 ENDIF 352 409 ! … … 377 434 ! 378 435 END SUBROUTINE p4z_fechem_init 379 380 #else381 !!======================================================================382 !! Dummy module : No PISCES bio-model383 !!======================================================================384 CONTAINS385 SUBROUTINE p4z_fechem ! Empty routine386 END SUBROUTINE p4z_fechem387 #endif388 389 436 !!====================================================================== 390 437 END MODULE p4zfechem -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r6962 r7403 11 11 !! ! 2011-02 (J. Simeon, J. Orr) Include total atm P correction 12 12 !!---------------------------------------------------------------------- 13 #if defined key_pisces14 !!----------------------------------------------------------------------15 !! 'key_pisces' PISCES bio-model16 !!----------------------------------------------------------------------17 13 !! p4z_flx : CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 18 14 !! p4z_flx_init : Read the namelist … … 26 22 USE iom ! I/O manager 27 23 USE fldread ! read input fields 28 #if defined key_cpl_carbon_cycle29 USE sbc_oce, ONLY : atm_co2 ! atmospheric pCO230 #endif31 24 32 25 IMPLICIT NONE … … 48 41 49 42 ! !!* nampisatm namelist (Atmospheric PRessure) * 50 LOGICAL, PUBLIC :: ln_presatm !: ref. pressure: global mean Patm (F) or a constant (F)51 52 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric pressure at kt [N/m2] 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_patm ! structure of input fields (file informations, fields read)54 55 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2 !: ocean carbon flux 43 LOGICAL, PUBLIC :: ln_presatm !: ref. pressure: global mean Patm (F) or a constant (F) 44 LOGICAL, PUBLIC :: ln_presatmco2 !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 45 46 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric pressure at kt [N/m2] 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_patm ! structure of input fields (file informations, fields read) 48 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_atmco2 ! structure of input fields (file informations, fields read) 49 57 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2 !: atmospheric pco2 58 51 … … 74 67 !! ** Method : 75 68 !! - Include total atm P correction via Esbensen & Kushnir (1981) 76 !! - Pressure correction NOT done for key_cpl_carbon_cycle77 69 !! - Remove Wanninkhof chemical enhancement; 78 70 !! - Add option for time-interpolation of atcco2.txt … … 85 77 REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact 86 78 REAL(wp) :: zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 87 REAL(wp) :: zph, z ah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co279 REAL(wp) :: zph, zdic, zsch_o2, zsch_co2 88 80 REAL(wp) :: zyr_dec, zdco2dt 89 81 CHARACTER (len=25) :: charout … … 100 92 ! IS USED TO COMPUTE AIR-SEA FLUX OF CO2 101 93 102 IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs103 104 IF( ln_co2int ) THEN94 IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 95 96 IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN 105 97 ! Linear temporal interpolation of atmospheric pco2. atcco2.txt has annual values. 106 98 ! Caveats: First column of .txt must be in years, decimal years preferably. … … 116 108 ENDIF 117 109 118 #if defined key_cpl_carbon_cycle 119 satmco2(:,:) = atm_co2(:,:) 120 #endif 121 122 DO jm = 1, 10 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 126 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 127 zbot = borat(ji,jj,1) 128 zfact = rhop(ji,jj,1) / 1000. + rtrn 129 zdic = trb(ji,jj,1,jpdic) / zfact 130 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 131 zalka = trb(ji,jj,1,jptal) / zfact 132 133 ! CALCULATE [ALK]([CO3--], [HCO3-]) 134 zalk = zalka - ( akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1) & 135 & + zbot / ( 1.+ zph / akb3(ji,jj,1) ) ) 136 137 ! CALCULATE [H+] AND [H2CO3] 138 zah2 = SQRT( (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1) & 139 & / ak13(ji,jj,1) ) * ( 2.* zdic - zalk ) ) 140 zah2 = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 ) 141 zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact 142 hi(ji,jj,1) = zah2 * zfact 143 END DO 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 115 zfact = rhop(ji,jj,1) / 1000. + rtrn 116 zdic = trb(ji,jj,1,jpdic) 117 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 118 ! CALCULATE [H2CO3] 119 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 144 120 END DO 145 121 END DO 146 147 122 148 123 ! -------------- … … 167 142 zkgwan = 0.251 * zws 168 143 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 169 # if defined key_degrad170 zkgwan = zkgwan * facvol(ji,jj,1)171 #endif172 144 ! compute gas exchange for CO2 and O2 173 145 zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) … … 176 148 END DO 177 149 150 178 151 DO jj = 1, jpj 179 152 DO ji = 1, jpi 180 ztkel = tsn(ji,jj,1,jp_tem) + 273.15181 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.153 ztkel = tempis(ji,jj,1) + 273.15 154 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 182 155 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 183 156 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) … … 232 205 ENDIF 233 206 IF( iom_use( "Dpo2" ) ) THEN 234 zw2d(:,:) = ( atcox * patm(:,:) - atcox * tr n(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)207 zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 235 208 CALL iom_put( "Dpo2" , zw2d ) 236 209 ENDIF … … 239 212 ! 240 213 CALL wrk_dealloc( jpi, jpj, zw2d ) 241 ELSE242 IF( ln_diatrc ) THEN243 trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r244 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)245 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)246 trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)247 ENDIF248 214 ENDIF 249 215 ! … … 287 253 WRITE(numout,*) ' ' 288 254 ENDIF 289 IF( .NOT.ln_co2int) THEN255 IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 290 256 IF(lwp) THEN ! control print 291 257 WRITE(numout,*) ' Constant Atmospheric pCO2 value atcco2 =', atcco2 … … 293 259 ENDIF 294 260 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 295 ELSE 261 ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 296 262 IF(lwp) THEN 297 263 WRITE(numout,*) ' Atmospheric pCO2 value from file clname =', TRIM( clname ) … … 315 281 END DO 316 282 CLOSE(numco2) 317 ENDIF 283 ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN 284 IF(lwp) THEN 285 WRITE(numout,*) ' Spatialized Atmospheric pCO2 from an external file' 286 WRITE(numout,*) ' ' 287 ENDIF 288 ELSE 289 IF(lwp) THEN 290 WRITE(numout,*) ' Spatialized Atmospheric pCO2 from an external file' 291 WRITE(numout,*) ' ' 292 ENDIF 293 ENDIF 294 318 295 ! 319 296 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon … … 341 318 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 342 319 TYPE(FLD_N) :: sn_patm ! informations about the fields to be read 343 !! 344 NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 320 TYPE(FLD_N) :: sn_atmco2 ! informations about the fields to be read 321 !! 322 NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 345 323 346 324 ! ! ----------------------- ! … … 361 339 WRITE(numout,*) ' Namelist nampisatm : Atmospheric Pressure as external forcing' 362 340 WRITE(numout,*) ' constant atmopsheric pressure (F) or from a file (T) ln_presatm = ', ln_presatm 341 WRITE(numout,*) ' spatial atmopsheric CO2 for flux calcs ln_presatmco2 = ', ln_presatmco2 363 342 WRITE(numout,*) 364 343 ENDIF … … 373 352 ENDIF 374 353 ! 354 IF( ln_presatmco2 ) THEN 355 ALLOCATE( sf_atmco2(1), STAT=ierr ) !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2 356 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' ) 357 ! 358 CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' ) 359 ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1) ) 360 IF( sn_atmco2%ln_tint ) ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) ) 361 ENDIF 362 ! 375 363 IF( .NOT.ln_presatm ) patm(:,:) = 1.e0 ! Initialize patm if no reading from a file 376 364 ! … … 382 370 ENDIF 383 371 ! 372 IF( ln_presatmco2 ) THEN 373 CALL fld_read( kt, 1, sf_atmco2 ) !* input atmco2 provided at kt + 1/2 374 satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1) ! atmospheric pressure 375 ELSE 376 satmco2(:,:) = atcco2 ! Initialize atmco2 if no reading from a file 377 ENDIF 378 ! 384 379 END SUBROUTINE p4z_patm 385 380 381 386 382 INTEGER FUNCTION p4z_flx_alloc() 387 383 !!---------------------------------------------------------------------- 388 384 !! *** ROUTINE p4z_flx_alloc *** 389 385 !!---------------------------------------------------------------------- 390 ALLOCATE( oce_co2(jpi,jpj),satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc )386 ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 391 387 ! 392 388 IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 393 389 ! 394 390 END FUNCTION p4z_flx_alloc 395 396 #else397 !!======================================================================398 !! Dummy module : No PISCES bio-model399 !!======================================================================400 CONTAINS401 SUBROUTINE p4z_flx( kt ) ! Empty routine402 INTEGER, INTENT( in ) :: kt403 WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt404 END SUBROUTINE p4z_flx405 #endif406 391 407 392 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r5656 r7403 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES bio-model12 !!----------------------------------------------------------------------13 9 !! p4z_int : interpolation and computation of various accessory fields 14 10 !!---------------------------------------------------------------------- … … 16 12 USE trc ! passive tracers common variables 17 13 USE sms_pisces ! PISCES Source Minus Sink variables 18 USE iom19 14 20 15 IMPLICIT NONE … … 70 65 END SUBROUTINE p4z_int 71 66 72 #else73 !!======================================================================74 !! Dummy module : No PISCES bio-model75 !!======================================================================76 CONTAINS77 SUBROUTINE p4z_int ! Empty routine78 WRITE(*,*) 'p4z_int: You should not have seen this print! error?'79 END SUBROUTINE p4z_int80 #endif81 82 67 !!====================================================================== 83 68 END MODULE p4zint -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r6945 r7403 8 8 !! 3.4 ! 2011-04 (O. Aumont, C. Ethe) Limitation for iron modelled in quota 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 !!----------------------------------------------------------------------14 10 !! p4z_lim : Compute the nutrients limitation terms 15 11 !! p4z_lim_init : Read the namelist … … 18 14 USE trc ! Tracers defined 19 15 USE sms_pisces ! PISCES variables 20 USE p4zopt ! Optical21 16 USE iom ! I/O manager 22 17 … … 26 21 PUBLIC p4z_lim 27 22 PUBLIC p4z_lim_init 23 PUBLIC p4z_lim_alloc 28 24 29 25 !! * Shared module variables … … 48 44 REAL(wp), PUBLIC :: qdfelim !: optimal Fe quota for diatoms 49 45 REAL(wp), PUBLIC :: caco3r !: mean rainratio 46 47 !!* Phytoplankton limitation terms 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanono3 !: ??? 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatno3 !: ??? 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanonh4 !: ??? 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatnh4 !: ??? 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanopo4 !: ??? 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatpo4 !: ??? 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimphy !: ??? 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdia !: ??? 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimnfe !: ??? 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdfe !: ??? 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimsi !: ??? 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbacl !: ?? 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concdfe !: ??? 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concnfe !: ??? 50 63 51 64 ! Coefficient for iron limitation … … 224 237 !!---------------------------------------------------------------------- 225 238 226 NAMELIST/namp islim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe, &239 NAMELIST/namp4zlim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe, & 227 240 & concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd, & 228 241 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin … … 230 243 231 244 REWIND( numnatp_ref ) ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 232 READ ( numnatp_ref, namp islim, IOSTAT = ios, ERR = 901)233 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp islim in reference namelist', lwp )245 READ ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 246 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 234 247 235 248 REWIND( numnatp_cfg ) ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 236 READ ( numnatp_cfg, namp islim, IOSTAT = ios, ERR = 902 )237 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp islim in configuration namelist', lwp )238 IF(lwm) WRITE ( numonp, namp islim )249 READ ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 250 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 251 IF(lwm) WRITE ( numonp, namp4zlim ) 239 252 240 253 IF(lwp) THEN ! control print 241 254 WRITE(numout,*) ' ' 242 WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp islim'255 WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim' 243 256 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 244 257 WRITE(numout,*) ' mean rainratio caco3r = ', caco3r … … 268 281 END SUBROUTINE p4z_lim_init 269 282 270 #else 271 !!====================================================================== 272 !! Dummy module : No PISCES bio-model 273 !!====================================================================== 274 CONTAINS 275 SUBROUTINE p4z_lim ! Empty routine 276 END SUBROUTINE p4z_lim 277 #endif 283 INTEGER FUNCTION p4z_lim_alloc() 284 !!---------------------------------------------------------------------- 285 !! *** ROUTINE p5z_lim_alloc *** 286 !!---------------------------------------------------------------------- 287 USE lib_mpp , ONLY: ctl_warn 288 !!---------------------------------------------------------------------- 289 290 !* Biological arrays for phytoplankton growth 291 ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 292 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 293 & xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk), & 294 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 295 & xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk), & 296 & xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk), & 297 & concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk), & 298 & xlimsi (jpi,jpj,jpk), STAT=p4z_lim_alloc ) 299 ! 300 IF( p4z_lim_alloc /= 0 ) CALL ctl_warn('p4z_lim_alloc : failed to allocate arrays.') 301 ! 302 END FUNCTION p4z_lim_alloc 278 303 279 304 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r6945 r7403 11 11 !! ! 2011-02 (J. Simeon, J. Orr) Calcon salinity dependence 12 12 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improvment of calcite dissolution 13 !!---------------------------------------------------------------------- 14 #if defined key_pisces 15 !!---------------------------------------------------------------------- 16 !! 'key_pisces' PISCES bio-model 13 !! 3.6 ! 2015-05 (O. Aumont) PISCES quota 17 14 !!---------------------------------------------------------------------- 18 15 !! p4z_lys : Compute the CaCO3 dissolution … … 22 19 USE trc ! passive tracers common variables 23 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zche ! Chemical model 24 22 USE prtctl_trc ! print control for debugging 25 23 USE iom ! I/O manager … … 61 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step 62 60 INTEGER :: ji, jj, jk, jn 63 REAL(wp) :: zalk, zdic, zph, zah2 64 REAL(wp) :: zdispot, zfact, zcalcon, zalka, zaldi 61 REAL(wp) :: zdispot, zfact, zcalcon 65 62 REAL(wp) :: zomegaca, zexcess, zexcess0 66 63 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zc o3sat, zcaldiss64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat 68 65 !!--------------------------------------------------------------------- 69 66 ! 70 67 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 71 68 ! 72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zc o3sat, zcaldiss)69 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 73 70 ! 74 71 zco3 (:,:,:) = 0. 75 72 zcaldiss(:,:,:) = 0. 73 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 76 74 ! ------------------------------------------- 77 75 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS 78 76 ! ------------------------------------------- 79 80 DO jn = 1, 5 ! BEGIN OF ITERATION 81 ! 82 DO jk = 1, jpkm1 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zfact = rhop(ji,jj,jk) / 1000. + rtrn 86 zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 87 zdic = trb(ji,jj,jk,jpdic) / zfact 88 zalka = trb(ji,jj,jk,jptal) / zfact 89 ! CALCULATE [ALK]([CO3--], [HCO3-]) 90 zalk = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn ) & 91 & + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 92 ! CALCULATE [H+] and [CO3--] 93 zaldi = zdic - zalk 94 zah2 = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 95 zah2 = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 96 ! 97 zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 98 hi(ji,jj,jk) = zah2 * zfact 99 END DO 77 78 CALL solve_at_general(zhinit, zhi) 79 80 DO jk = 1, jpkm1 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 84 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 85 hi(ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 100 86 END DO 101 87 END DO 102 ! 103 END DO 88 END DO 104 89 105 90 ! --------------------------------------------------------- … … 115 100 ! DEVIATION OF [CO3--] FROM SATURATION VALUE 116 101 ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 117 zcalcon = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp )102 zcalcon = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 118 103 zfact = rhop(ji,jj,jk) / 1000._wp 119 104 zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) … … 129 114 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 130 115 zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 131 # if defined key_degrad132 zdispot = zdispot * facvol(ji,jj,jk)133 # endif134 116 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 135 117 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 136 118 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 137 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)138 119 ! 139 120 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) … … 150 131 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3 * tmask(:,:,:) ) 151 132 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 152 ELSE153 IF( ln_diatrc ) THEN154 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)155 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:)156 trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:) * tmask(:,:,:)157 ENDIF158 133 ENDIF 159 134 ! … … 164 139 ENDIF 165 140 ! 166 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zc o3sat, zcaldiss)141 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 167 142 ! 168 143 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') … … 183 158 !! 184 159 !!---------------------------------------------------------------------- 185 INTEGER :: ji, jj, jk186 160 INTEGER :: ios ! Local integer output status for namelist read 187 REAL(wp) :: zcaralk, zbicarb, zco3188 REAL(wp) :: ztmas, ztmas1189 161 190 162 NAMELIST/nampiscal/ kdca, nca … … 212 184 ! 213 185 END SUBROUTINE p4z_lys_init 214 215 #else216 !!======================================================================217 !! Dummy module : No PISCES bio-model218 !!======================================================================219 CONTAINS220 SUBROUTINE p4z_lys( kt ) ! Empty routine221 INTEGER, INTENT( in ) :: kt222 WRITE(*,*) 'p4z_lys: You should not have seen this print! error?', kt223 END SUBROUTINE p4z_lys224 #endif225 186 !!====================================================================== 226 187 END MODULE p4zlys -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r5836 r7403 8 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 !!----------------------------------------------------------------------14 10 !! p4z_meso : Compute the sources/sinks for mesozooplankton 15 11 !! p4z_meso_init : Initialization of the parameters for mesozooplankton … … 18 14 USE trc ! passive tracers common variables 19 15 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zsink ! vertical flux of particulate matter due to sinking21 USE p4zint ! interpolation and computation of various fields22 16 USE p4zprod ! production 23 17 USE prtctl_trc ! print control for debugging … … 70 64 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 71 65 REAL(wp) :: zgraze2 , zdenom, zdenom2 72 REAL(wp) :: zfact , z step, zfood, zfoodlim, zproport73 REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2 66 REAL(wp) :: zfact , zfood, zfoodlim, zproport 67 REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 74 68 REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 75 69 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat, zgrasratn 76 #if defined key_kriest77 REAL znumpoc78 #endif79 70 REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 80 71 REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf … … 87 78 IF( nn_timing == 1 ) CALL timing_start('p4z_meso') 88 79 ! 89 IF( lk_iomput ) THEN 90 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 91 zgrazing(:,:,:) = 0._wp 92 ENDIF 80 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 81 zgrazing(:,:,:) = 0._wp 93 82 94 83 DO jk = 1, jpkm1 … … 96 85 DO ji = 1, jpi 97 86 zcompam = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 98 # if defined key_degrad 99 zstep = xstep * facvol(ji,jj,jk) 100 # else 101 zstep = xstep 102 # endif 103 zfact = zstep * tgfunc2(ji,jj,jk) * zcompam 87 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 104 88 105 89 ! Respiration rates of both zooplankton … … 126 110 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 127 111 zdenom2 = zdenom / ( zfood + rtrn ) 128 zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)112 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 129 113 130 114 zgrazd = zgraze2 * xprefc * zcompadi * zdenom2 … … 140 124 ! ---------------------------------- 141 125 ! ---------------------------------- 142 # if ! defined key_kriest 143 zgrazffeg = grazflux * zstep * wsbio4(ji,jj,jk) & 126 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 144 127 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) 145 128 zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 146 # endif 147 zgrazffep = grazflux * zstep * wsbio3(ji,jj,jk) & 129 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 148 130 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) 149 131 zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 150 132 ! 151 # if ! defined key_kriest152 133 zgraztot = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 153 134 ! Compute the proportion of filter feeders … … 158 139 zratio = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 159 140 zratio2 = zratio * zratio 160 zfrac = zproport * grazflux * zstep * wsbio4(ji,jj,jk) &141 zfrac = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 161 142 & * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 162 143 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) … … 171 152 & + zgrazpoc + zgrazffep + zgrazffeg 172 153 zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 173 # else174 zgraztot = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep175 ! Compute the proportion of filter feeders176 zproport = zgrazffep / ( zgraztot + rtrn )177 zgrazffep = zproport * zgrazffep178 zgrazfffp = zproport * zgrazfffp179 zgraztot = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep180 zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) + zgrazpoc + zgrazffep181 zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp182 # endif183 154 184 155 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 185 IF( lk_iomput )zgrazing(ji,jj,jk) = zgraztot156 zgrazing(ji,jj,jk) = zgraztot 186 157 187 158 ! Mesozooplankton efficiency … … 202 173 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 203 174 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 175 ! 176 IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 177 ! 204 178 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 205 179 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 … … 220 194 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 221 195 222 ! calcite production223 zprcaca = xfracal(ji,jj,jk) * zgrazn224 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)225 !226 zprcaca = part2 * zprcaca227 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca228 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca229 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca230 #if defined key_kriest231 znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )232 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2233 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso &234 & + zmortzgoc * xkr_dmeso - zgrazffep * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn )235 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortzgoc - zgrazfffp - zgrazpof &236 & + zgraztotf * unass2237 #else238 196 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 197 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 198 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 239 199 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 200 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 201 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 240 202 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 241 203 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg & 242 204 & + zgraztotf * unass2 - zfracfe 243 #endif 205 zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 206 zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 207 ! calcite production 208 zprcaca = xfracal(ji,jj,jk) * zgrazn 209 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 210 ! 211 zprcaca = part2 * zprcaca 212 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 213 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 214 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 244 215 END DO 245 216 END DO … … 265 236 ENDIF 266 237 ! 267 IF( lk_iomput )CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )238 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 268 239 ! 269 240 IF( nn_timing == 1 ) CALL timing_stop('p4z_meso') … … 285 256 !!---------------------------------------------------------------------- 286 257 287 NAMELIST/namp ismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz, &258 NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz, & 288 259 & xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 289 260 & xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux … … 291 262 292 263 REWIND( numnatp_ref ) ! Namelist nampismes in reference namelist : Pisces mesozooplankton 293 READ ( numnatp_ref, namp ismes, IOSTAT = ios, ERR = 901)294 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp ismes in reference namelist', lwp )264 READ ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 265 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 295 266 296 267 REWIND( numnatp_cfg ) ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 297 READ ( numnatp_cfg, namp ismes, IOSTAT = ios, ERR = 902 )298 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp ismes in configuration namelist', lwp )299 IF(lwm) WRITE ( numonp, namp ismes )268 READ ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 269 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 270 IF(lwm) WRITE ( numonp, namp4zmes ) 300 271 301 272 302 273 IF(lwp) THEN ! control print 303 274 WRITE(numout,*) ' ' 304 WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp ismes'275 WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes' 305 276 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 306 277 WRITE(numout,*) ' part of calcite not dissolved in mesozoo guts part2 =', part2 … … 327 298 END SUBROUTINE p4z_meso_init 328 299 329 330 #else331 !!======================================================================332 !! Dummy module : No PISCES bio-model333 !!======================================================================334 CONTAINS335 SUBROUTINE p4z_meso ! Empty routine336 END SUBROUTINE p4z_meso337 #endif338 339 300 !!====================================================================== 340 301 END MODULE p4zmeso -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r5836 r7403 8 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 !!----------------------------------------------------------------------14 10 !! p4z_micro : Compute the sources/sinks for microzooplankton 15 11 !! p4z_micro_init : Initialize and read the appropriate namelist … … 19 15 USE sms_pisces ! PISCES Source Minus Sink variables 20 16 USE p4zlim ! Co-limitations 21 USE p4zsink ! vertical flux of particulate matter due to sinking22 USE p4zint ! interpolation and computation of various fields23 17 USE p4zprod ! production 24 18 USE iom ! I/O manager … … 71 65 REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 72 66 REAL(wp) :: zgraze , zdenom, zdenom2 73 REAL(wp) :: zfact , z step, zfood, zfoodlim67 REAL(wp) :: zfact , zfood, zfoodlim 74 68 REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 75 69 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz … … 83 77 IF( nn_timing == 1 ) CALL timing_start('p4z_micro') 84 78 ! 85 IF( lk_iomput )CALL wrk_alloc( jpi, jpj, jpk, zgrazing )79 CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 86 80 ! 87 81 DO jk = 1, jpkm1 … … 89 83 DO ji = 1, jpi 90 84 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 91 zstep = xstep 92 # if defined key_degrad 93 zstep = zstep * facvol(ji,jj,jk) 94 # endif 95 zfact = zstep * tgfunc2(ji,jj,jk) * zcompaz 85 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 96 86 97 87 ! Respiration rates of both zooplankton … … 115 105 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 116 106 zdenom2 = zdenom / ( zfood + rtrn ) 117 zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)107 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 118 108 119 109 zgrazp = zgraze * xpref2p * zcompaph * zdenom2 … … 130 120 131 121 ! Grazing by microzooplankton 132 IF( ln_diatrc .AND. lk_iomput )zgrazing(ji,jj,jk) = zgraztot122 zgrazing(ji,jj,jk) = zgraztot 133 123 134 124 ! Various remineralization and excretion terms … … 148 138 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 149 139 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 140 ! 141 IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 142 ! 150 143 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 151 144 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 152 145 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 146 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 153 147 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 154 148 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 155 149 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 156 #if defined key_kriest157 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_dmicro158 #endif159 150 ! Update the arrays TRA which contain the biological sources and sinks 160 151 ! -------------------------------------------------------------------- … … 170 161 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 171 162 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 163 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 164 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 172 165 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 173 166 ! … … 180 173 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 181 174 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 182 #if defined key_kriest183 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro &184 - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )185 #endif186 175 END DO 187 176 END DO 188 177 END DO 189 178 ! 190 IF( lk_iomput .AND. knt == nrdttrc ) THEN 191 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 192 IF( iom_use( "GRAZ1" ) ) THEN 193 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 194 CALL iom_put( "GRAZ1", zw3d ) 179 IF( lk_iomput ) THEN 180 IF( knt == nrdttrc ) THEN 181 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 182 IF( iom_use( "GRAZ1" ) ) THEN 183 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 184 CALL iom_put( "GRAZ1", zw3d ) 185 ENDIF 186 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 195 187 ENDIF 196 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )197 188 ENDIF 198 189 ! … … 203 194 ENDIF 204 195 ! 205 IF( lk_iomput )CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )196 CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 206 197 ! 207 198 IF( nn_timing == 1 ) CALL timing_stop('p4z_micro') … … 224 215 !!---------------------------------------------------------------------- 225 216 226 NAMELIST/namp iszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, &217 NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 227 218 & xpref2d, xthreshdia, xthreshphy, xthreshpoc, & 228 219 & xthresh, xkgraz, epsher, sigma1, unass … … 230 221 231 222 REWIND( numnatp_ref ) ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 232 READ ( numnatp_ref, namp iszoo, IOSTAT = ios, ERR = 901)233 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp iszoo in reference namelist', lwp )223 READ ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 224 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 234 225 235 226 REWIND( numnatp_cfg ) ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 236 READ ( numnatp_cfg, namp iszoo, IOSTAT = ios, ERR = 902 )237 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp iszoo in configuration namelist', lwp )238 IF(lwm) WRITE ( numonp, namp iszoo )227 READ ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 228 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 229 IF(lwm) WRITE ( numonp, namp4zzoo ) 239 230 240 231 IF(lwp) THEN ! control print 241 232 WRITE(numout,*) ' ' 242 WRITE(numout,*) ' Namelist parameters for microzooplankton, namp iszoo'233 WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo' 243 234 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 244 235 WRITE(numout,*) ' part of calcite not dissolved in microzoo guts part =', part … … 261 252 END SUBROUTINE p4z_micro_init 262 253 263 #else264 !!======================================================================265 !! Dummy module : No PISCES bio-model266 !!======================================================================267 CONTAINS268 SUBROUTINE p4z_micro ! Empty routine269 END SUBROUTINE p4z_micro270 #endif271 272 254 !!====================================================================== 273 255 END MODULE p4zmicro -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r5836 r7403 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES bio-model12 !!----------------------------------------------------------------------13 9 !! p4z_mort : Compute the mortality terms for phytoplankton 14 10 !! p4z_mort_init : Initialize the mortality params for phytoplankton … … 17 13 USE trc ! passive tracers common variables 18 14 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE p4zsink ! vertical flux of particulate matter due to sinking20 15 USE p4zprod ! Primary productivity 16 USE p4zlim ! Phytoplankton limitation terms 21 17 USE prtctl_trc ! print control for debugging 22 18 … … 34 30 REAL(wp), PUBLIC :: mprat2 !: 35 31 36 37 32 !!---------------------------------------------------------------------- 38 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 73 68 REAL(wp) :: zsizerat, zcompaph 74 69 REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 75 REAL(wp) :: ztortp , zrespp , zmortp , zstep70 REAL(wp) :: ztortp , zrespp , zmortp 76 71 CHARACTER (len=25) :: charout 77 72 !!--------------------------------------------------------------------- … … 84 79 DO ji = 1, jpi 85 80 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 86 zstep = xstep87 # if defined key_degrad88 zstep = zstep * facvol(ji,jj,jk)89 # endif90 81 ! When highly limited by macronutrients, very small cells 91 82 ! dominate the community. As a consequence, aggregation … … 95 86 ! Squared mortality of Phyto similar to a sedimentation term during 96 87 ! blooms (Doney et al. 1996) 97 zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * zsizerat88 zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 98 89 99 90 ! Phytoplankton mortality. This mortality loss is slightly … … 119 110 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 120 111 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 121 #if defined key_kriest122 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp123 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat124 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe125 #else126 112 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 127 113 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 114 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 115 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 128 116 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 129 117 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 130 #endif131 118 END DO 132 119 END DO … … 153 140 INTEGER :: ji, jj, jk 154 141 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi 155 REAL(wp) :: zrespp2, ztortp2, zmortp2 , zstep142 REAL(wp) :: zrespp2, ztortp2, zmortp2 156 143 REAL(wp) :: zlim2, zlim1 157 144 CHARACTER (len=25) :: charout … … 176 163 ! sticky and coagulate to sink quickly out of the euphotic zone 177 164 ! ------------------------------------------------------------ 178 zstep = xstep179 # if defined key_degrad180 zstep = zstep * facvol(ji,jj,jk)181 # endif182 165 ! Phytoplankton respiration 183 166 ! ------------------------ 184 167 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 185 168 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 186 zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)169 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 187 170 188 171 ! Phytoplankton mortality. 189 172 ! ------------------------ 190 ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi173 ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 191 174 192 175 zmortp2 = zrespp2 + ztortp2 … … 202 185 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 203 186 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 204 #if defined key_kriest205 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2206 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr207 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe208 #else209 187 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 210 188 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 189 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 190 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 211 191 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 212 192 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 213 #endif214 193 END DO 215 194 END DO … … 240 219 !!---------------------------------------------------------------------- 241 220 242 NAMELIST/namp ismort/ wchl, wchld, wchldm, mprat, mprat2221 NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2 243 222 INTEGER :: ios ! Local integer output status for namelist read 244 223 245 224 REWIND( numnatp_ref ) ! Namelist nampismort in reference namelist : Pisces phytoplankton 246 READ ( numnatp_ref, namp ismort, IOSTAT = ios, ERR = 901)247 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp ismort in reference namelist', lwp )225 READ ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 226 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 248 227 249 228 REWIND( numnatp_cfg ) ! Namelist nampismort in configuration namelist : Pisces phytoplankton 250 READ ( numnatp_cfg, namp ismort, IOSTAT = ios, ERR = 902 )251 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp ismort in configuration namelist', lwp )252 IF(lwm) WRITE ( numonp, namp ismort )229 READ ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 230 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 231 IF(lwm) WRITE ( numonp, namp4zmort ) 253 232 254 233 IF(lwp) THEN ! control print 255 234 WRITE(numout,*) ' ' 256 WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp ismort'235 WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort' 257 236 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 258 237 WRITE(numout,*) ' quadratic mortality of phytoplankton wchl =', wchl … … 265 244 END SUBROUTINE p4z_mort_init 266 245 267 #else268 !!======================================================================269 !! Dummy module : No PISCES bio-model270 !!======================================================================271 CONTAINS272 SUBROUTINE p4z_mort ! Empty routine273 END SUBROUTINE p4z_mort274 #endif275 276 246 !!====================================================================== 277 247 END MODULE p4zmort -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r6962 r7403 9 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 10 10 !!---------------------------------------------------------------------- 11 #if defined key_pisces12 !!----------------------------------------------------------------------13 !! 'key_pisces' PISCES bio-model14 !!----------------------------------------------------------------------15 11 !! p4z_opt : light availability in the water column 16 12 !!---------------------------------------------------------------------- … … 41 37 INTEGER :: ntimes_par ! number of time steps in a file 42 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw !: PAR fraction of shortwave 43 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 48 40 49 41 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 50 42 51 REAL(wp), DIMENSION(3,61) , PUBLIC:: xkrgb !: tabulated attenuation coefficients for RGB absorption43 REAL(wp), DIMENSION(3,61) :: xkrgb !: tabulated attenuation coefficients for RGB absorption 52 44 53 45 !!---------------------------------------------------------------------- … … 75 67 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 76 68 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zetmp5 77 70 REAL(wp), POINTER, DIMENSION(:,: ) :: zqsr100, zqsr_corr 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d 79 72 !!--------------------------------------------------------------------- 80 73 ! … … 82 75 ! 83 76 ! Allocate temporary workspace 84 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 85 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 86 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3 ) 77 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 78 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 79 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, zetmp5 ) 80 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 87 81 88 82 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 93 87 ze2(:,:,:) = 0._wp 94 88 ze3(:,:,:) = 0._wp 89 ! 95 90 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 96 DO jk = 1, jpkm1 ! -------------------------------------------------------- 91 ! -------------------------------------------------------- 92 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 93 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 94 ! 95 DO jk = 1, jpkm1 97 96 DO jj = 1, jpj 98 97 DO ji = 1, jpi 99 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e698 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 100 99 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 101 100 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) … … 120 119 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 121 120 END DO 121 IF( ln_p5z ) THEN 122 DO jk = 1, nksrp 123 epico (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 124 END DO 125 ENDIF 122 126 ! 123 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) … … 140 144 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 141 145 END DO 146 IF( ln_p5z ) THEN 147 DO jk = 1, nksrp 148 epico(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 149 END DO 150 ENDIF 142 151 etot_ndcy(:,:,:) = etot(:,:,:) 143 152 ENDIF … … 155 164 ENDIF 156 165 ! !* Euphotic depth and level 157 neln(:,:) = 1 ! ------------------------ 158 heup(:,:) = 300. 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 159 169 160 170 DO jk = 2, nksrp … … 166 176 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 167 177 ENDIF 178 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 179 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth (light level definition) 180 ENDIF 168 181 END DO 169 182 END DO 170 183 END DO 171 184 ! 172 heup(:,:) = MIN( 300., heup(:,:) ) 185 heup (:,:) = MIN( 300., heup (:,:) ) 186 heup_01(:,:) = MIN( 300., heup_01(:,:) ) 173 187 ! !* mean light over the mixed layer 174 188 zdepmoy(:,:) = 0.e0 ! ------------------------------- … … 209 223 END DO 210 224 ! 225 IF( ln_p5z ) THEN 226 zetmp5 (:,:) = 0.e0 227 DO jk = 1, nksrp 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 231 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 232 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 233 epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 234 ENDIF 235 END DO 236 END DO 237 END DO 238 ENDIF 211 239 IF( lk_iomput ) THEN 212 240 IF( knt == nrdttrc ) THEN … … 215 243 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 216 244 ENDIF 217 ELSE 218 IF( ln_diatrc ) THEN ! save output diagnostics 219 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 220 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 221 ENDIF 222 ENDIF 223 ! 224 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 225 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 226 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3 ) 245 ENDIF 246 ! 247 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 248 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 249 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, zetmp5 ) 250 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 227 251 ! 228 252 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 407 431 enano (:,:,:) = 0._wp 408 432 ediat (:,:,:) = 0._wp 433 IF( ln_p5z ) epico (:,:,:) = 0._wp 409 434 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 410 435 ! … … 418 443 !! *** ROUTINE p4z_opt_alloc *** 419 444 !!---------------------------------------------------------------------- 420 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), &421 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk),&422 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc)423 445 ! 446 ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 447 ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc ) 448 ! 424 449 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 425 450 ! 426 451 END FUNCTION p4z_opt_alloc 427 428 #else429 !!----------------------------------------------------------------------430 !! Dummy module : No PISCES bio-model431 !!----------------------------------------------------------------------432 CONTAINS433 SUBROUTINE p4z_opt ! Empty routine434 END SUBROUTINE p4z_opt435 #endif436 452 437 453 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r6945 r7403 8 8 !! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 !!----------------------------------------------------------------------14 10 !! p4z_prod : Compute the growth Rate of the two phytoplanktons groups 15 11 !! p4z_prod_init : Initialization of the parameters for growth … … 19 15 USE trc ! passive tracers common variables 20 16 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zopt ! optical model22 17 USE p4zlim ! Co-limitations of differents nutrients 23 18 USE prtctl_trc ! print control for debugging … … 33 28 !! * Shared module variables 34 29 LOGICAL , PUBLIC :: ln_newprod !: 35 REAL(wp), PUBLIC :: pislope !:36 REAL(wp), PUBLIC :: pislope 2!:30 REAL(wp), PUBLIC :: pislopen !: 31 REAL(wp), PUBLIC :: pisloped !: 37 32 REAL(wp), PUBLIC :: xadap !: 38 REAL(wp), PUBLIC :: excret !:39 REAL(wp), PUBLIC :: excret 2!:33 REAL(wp), PUBLIC :: excretn !: 34 REAL(wp), PUBLIC :: excretd !: 40 35 REAL(wp), PUBLIC :: bresp !: 41 36 REAL(wp), PUBLIC :: chlcnm !: … … 51 46 52 47 REAL(wp) :: r1_rday !: 1 / rday 53 REAL(wp) :: texcret !: 1 - excret54 REAL(wp) :: texcret 2 !: 1 - excret248 REAL(wp) :: texcretn !: 1 - excretn 49 REAL(wp) :: texcretd !: 1 - excretd 55 50 56 51 !!---------------------------------------------------------------------- … … 75 70 INTEGER :: ji, jj, jk 76 71 REAL(wp) :: zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 77 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 78 REAL(wp) :: z lim, zsilfac2, zsiborn, zprod, zproreg, zproreg279 REAL(wp) :: zm xltst, zmxlday, zmaxday80 REAL(wp) :: z pislopen , zpislope2n81 REAL(wp) :: zrum, zcodel, zargu, zval 72 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn 73 REAL(wp) :: zprod, zproreg, zproreg2, zprochln, zprochld 74 REAL(wp) :: zmaxday, zdocprod, zpislopen, zpisloped 75 REAL(wp) :: zmxltst, zmxlday 76 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n 82 77 REAL(wp) :: zfact 83 78 CHARACTER (len=25) :: charout 84 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn, zw2d 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 79 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d, zmixnano, zmixdiat 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 87 85 !!--------------------------------------------------------------------- 88 86 ! … … 90 88 ! 91 89 ! Allocate temporary workspace 92 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 93 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 94 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 95 ! 96 zprorca (:,:,:) = 0._wp 97 zprorcad(:,:,:) = 0._wp 98 zprofed (:,:,:) = 0._wp 99 zprofen (:,:,:) = 0._wp 100 zprochln(:,:,:) = 0._wp 101 zprochld(:,:,:) = 0._wp 102 zpronew (:,:,:) = 0._wp 103 zpronewd(:,:,:) = 0._wp 104 zprdia (:,:,:) = 0._wp 105 zprbio (:,:,:) = 0._wp 106 zprdch (:,:,:) = 0._wp 107 zprnch (:,:,:) = 0._wp 108 zysopt (:,:,:) = 0._wp 90 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 91 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 92 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 93 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 94 ! 95 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 96 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 97 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 98 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 99 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 109 100 110 101 ! Computation of the optimal production 111 prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 112 IF( lk_degrad ) prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 113 103 114 104 ! compute the day length depending on latitude and the day … … 126 116 END DO 127 117 128 ! Impact of the day duration on phytoplankton growth118 ! Impact of the day duration and light intermittency on phytoplankton growth 129 119 DO jk = 1, jpkm1 130 120 DO jj = 1 ,jpj … … 132 122 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 133 123 zval = MAX( 1., zstrn(ji,jj) ) 134 zval = 1.5 * zval / ( 12. + zval ) 135 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 136 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 124 IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 125 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 126 ENDIF 127 zmxl_chl(ji,jj,jk) = zval / 24. 128 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 137 129 ENDIF 138 130 END DO 139 131 END DO 140 132 END DO 133 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 141 136 142 137 ! Maximum light intensity 143 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 144 zstrn(:,:) = 24. / zstrn(:,:) 139 140 ! Computation of the P-I slope for nanos and diatoms 141 DO jk = 1, jpkm1 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 145 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 146 zadap = xadap * ztn / ( 2.+ ztn ) 147 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 148 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 149 ! 150 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 151 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 152 ! 153 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 154 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 155 ENDIF 156 END DO 157 END DO 158 END DO 145 159 146 160 IF( ln_newprod ) THEN … … 148 162 DO jj = 1, jpj 149 163 DO ji = 1, jpi 150 ! Computation of the P-I slope for nanos and diatoms151 164 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 152 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )153 zadap = xadap * ztn / ( 2.+ ztn )154 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )155 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp156 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)157 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)158 !159 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) &160 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)161 !162 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) &163 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)164 165 165 ! Computation of production function for Carbon 166 166 ! --------------------------------------------- 167 zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 168 zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 169 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 170 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 171 167 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 168 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 169 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 170 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 171 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 172 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 172 173 ! Computation of production function for Chlorophyll 173 174 !-------------------------------------------------- 174 zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 175 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 176 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 175 zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 176 zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 177 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 178 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 177 179 ENDIF 178 180 END DO … … 183 185 DO jj = 1, jpj 184 186 DO ji = 1, jpi 185 186 ! Computation of the P-I slope for nanos and diatoms187 187 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 188 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )189 zadap = ztn / ( 2.+ ztn )190 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )191 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp192 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)193 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)194 !195 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) )196 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )197 198 zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) &199 & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) &200 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )201 202 zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) &203 & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) &204 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )205 206 188 ! Computation of production function for Carbon 207 189 ! --------------------------------------------- 208 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 209 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 210 190 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 191 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 192 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 193 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 211 194 ! Computation of production function for Chlorophyll 212 195 !-------------------------------------------------- 213 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 214 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 196 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 197 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 198 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 199 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 215 200 ENDIF 216 201 END DO … … 218 203 END DO 219 204 ENDIF 220 221 205 222 206 ! Computation of a proxy of the N/C ratio … … 261 245 END DO 262 246 263 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 267 zmxlday = zmxltst * zmxltst * r1_rday 268 zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 269 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 270 END DO 271 END DO 272 273 ! Mixed-layer effect on production 274 DO jk = 1, jpkm1 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 278 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 280 ENDIF 247 ! Mixed-layer effect on production 248 ! Sea-ice effect on production 249 250 DO jk = 1, jpkm1 251 DO jj = 1, jpj 252 DO ji = 1, jpi 281 253 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 282 254 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 290 262 DO ji = 1, jpi 291 263 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 292 ! production terms for nanophyto. 293 zprorca (ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2294 zpronew (ji,jj,jk) = zprorca(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )264 ! production terms for nanophyto. (C) 265 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 266 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 295 267 ! 296 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 297 zratio = zratio / fecnm 268 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 298 269 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 299 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) &270 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 300 271 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 301 272 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 302 273 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 303 ! production terms for diatom ees274 ! production terms for diatoms (C) 304 275 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 305 276 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 306 277 ! 307 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 308 zratio = zratio / fecdm 278 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 309 279 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 310 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) &280 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 311 281 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 312 282 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & … … 317 287 END DO 318 288 319 DO jk = 1, jpkm1 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 323 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 324 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 325 ENDIF 289 ! Computation of the chlorophyll production terms 290 DO jk = 1, jpkm1 291 DO jj = 1, jpj 292 DO ji = 1, jpi 326 293 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 327 294 ! production terms for nanophyto. ( chlorophyll ) 328 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 329 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 330 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 331 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 332 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 333 ! production terms for diatomees ( chlorophyll ) 334 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 335 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 336 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 337 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 338 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 295 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 296 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 297 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 298 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 299 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 300 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 301 ! production terms for diatoms ( chlorophyll ) 302 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 303 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 304 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 305 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 306 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 307 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 308 ! Update the arrays TRA which contain the Chla sources and sinks 309 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 310 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 339 311 ENDIF 340 312 END DO … … 346 318 DO jj = 1, jpj 347 319 DO ji =1 ,jpi 348 zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 349 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 350 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 351 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 352 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 353 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 354 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 355 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 356 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 357 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 358 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 359 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 360 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 361 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 362 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 363 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 364 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 365 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 366 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 367 & - rno3 * ( zproreg + zproreg2 ) 368 END DO 320 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 321 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 322 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 323 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 324 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 325 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 326 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 327 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 328 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 329 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 330 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 331 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 332 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 333 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 334 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 335 ! 336 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 337 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 338 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 339 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 340 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 341 & - rno3 * ( zproreg + zproreg2 ) 342 ENDIF 343 END DO 369 344 END DO 370 345 END DO 346 ! 347 IF( ln_ligand ) THEN 348 DO jk = 1, jpkm1 349 DO jj = 1, jpj 350 DO ji =1 ,jpi 351 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 352 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 353 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 354 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 355 ENDIF 356 END DO 357 END DO 358 END DO 359 ENDIF 371 360 372 361 373 362 ! Total primary production per year 374 363 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 375 & tpp = glob_sum( ( zprorca (:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )364 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 376 365 377 366 IF( lk_iomput ) THEN … … 381 370 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 382 371 ! 383 IF( iom_use( "PPPHY " ) .OR. iom_use( "PPPHY2" ) ) THEN384 zw3d(:,:,:) = zprorca 385 CALL iom_put( "PPPHY " , zw3d )372 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 373 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 374 CALL iom_put( "PPPHYN" , zw3d ) 386 375 ! 387 376 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 388 CALL iom_put( "PPPHY 2" , zw3d )377 CALL iom_put( "PPPHYD" , zw3d ) 389 378 ENDIF 390 379 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 391 zw3d(:,:,:) = zpronew 380 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 392 381 CALL iom_put( "PPNEWN" , zw3d ) 393 382 ! … … 425 414 ENDIF 426 415 IF( iom_use( "TPP" ) ) THEN 427 zw3d(:,:,:) = ( zprorca (:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production416 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 428 417 CALL iom_put( "TPP" , zw3d ) 429 418 ENDIF 430 419 IF( iom_use( "TPNEW" ) ) THEN 431 zw3d(:,:,:) = ( zpronew (:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production420 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 432 421 CALL iom_put( "TPNEW" , zw3d ) 433 422 ENDIF … … 436 425 CALL iom_put( "TPBFE" , zw3d ) 437 426 ENDIF 438 IF( iom_use( "INTPPPHY " ) .OR. iom_use( "INTPPPHY2" ) ) THEN427 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 439 428 zw2d(:,:) = 0. 440 429 DO jk = 1, jpkm1 441 zw2d(:,:) = zw2d(:,:) + zprorca 430 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 442 431 ENDDO 443 CALL iom_put( "INTPPPHY " , zw2d )432 CALL iom_put( "INTPPPHYN" , zw2d ) 444 433 ! 445 434 zw2d(:,:) = 0. … … 447 436 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 448 437 ENDDO 449 CALL iom_put( "INTPPPHY 2" , zw2d )438 CALL iom_put( "INTPPPHYD" , zw2d ) 450 439 ENDIF 451 440 IF( iom_use( "INTPP" ) ) THEN 452 441 zw2d(:,:) = 0. 453 442 DO jk = 1, jpkm1 454 zw2d(:,:) = zw2d(:,:) + ( zprorca (:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp443 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 455 444 ENDDO 456 445 CALL iom_put( "INTPP" , zw2d ) … … 459 448 zw2d(:,:) = 0. 460 449 DO jk = 1, jpkm1 461 zw2d(:,:) = zw2d(:,:) + ( zpronew (:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod450 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 462 451 ENDDO 463 452 CALL iom_put( "INTPNEW" , zw2d ) … … 482 471 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 483 472 ENDIF 484 ELSE485 IF( ln_diatrc ) THEN486 zfact = 1.e+3 * rfact2r487 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zfact * tmask(:,:,:)488 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zfact * tmask(:,:,:)489 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zfact * tmask(:,:,:)490 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zfact * tmask(:,:,:)491 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)492 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zfact * tmask(:,:,:)493 # if ! defined key_kriest494 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:)495 # endif496 ENDIF497 473 ENDIF 498 474 … … 503 479 ENDIF 504 480 ! 505 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 506 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 507 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 481 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 482 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 483 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 484 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 508 485 ! 509 486 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') … … 524 501 !!---------------------------------------------------------------------- 525 502 ! 526 NAMELIST/namp isprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2, &503 NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd, & 527 504 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 528 505 INTEGER :: ios ! Local integer output status for namelist read … … 530 507 531 508 REWIND( numnatp_ref ) ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 532 READ ( numnatp_ref, namp isprod, IOSTAT = ios, ERR = 901)533 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in reference namelist', lwp )509 READ ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 510 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 534 511 535 512 REWIND( numnatp_cfg ) ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 536 READ ( numnatp_cfg, namp isprod, IOSTAT = ios, ERR = 902 )537 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in configuration namelist', lwp )538 IF(lwm) WRITE ( numonp, namp isprod )513 READ ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 514 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 515 IF(lwm) WRITE ( numonp, namp4zprod ) 539 516 540 517 IF(lwp) THEN ! control print 541 518 WRITE(numout,*) ' ' 542 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp isprod'519 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 543 520 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 544 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod521 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 545 522 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 546 WRITE(numout,*) ' P-I slope pislope =', pislope547 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap548 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret549 WRITE(numout,*) ' excretion ratio of diatoms excret 2 =', excret2523 WRITE(numout,*) ' P-I slope pislopen =', pislopen 524 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 525 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 526 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 550 527 IF( ln_newprod ) THEN 551 528 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 552 529 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 553 530 ENDIF 554 WRITE(numout,*) ' P-I slope for diatoms pislope 2 =', pislope2531 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 555 532 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 556 533 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm … … 560 537 ! 561 538 r1_rday = 1._wp / rday 562 texcret = 1._wp - excret563 texcret 2 = 1._wp - excret2539 texcretn = 1._wp - excretn 540 texcretd = 1._wp - excretd 564 541 tpp = 0._wp 565 542 ! … … 576 553 ! 577 554 END FUNCTION p4z_prod_alloc 578 579 #else580 !!======================================================================581 !! Dummy module : No PISCES bio-model582 !!======================================================================583 CONTAINS584 SUBROUTINE p4z_prod ! Empty routine585 END SUBROUTINE p4z_prod586 #endif587 588 555 !!====================================================================== 589 556 END MODULE p4zprod -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r6945 r7403 8 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_top' and TOP models13 !! 'key_pisces' PISCES bio-model14 !!----------------------------------------------------------------------15 10 !! p4z_rem : Compute remineralization/dissolution of organic compounds 16 11 !! p4z_rem_init : Initialisation of parameters for remineralisation … … 20 15 USE trc ! passive tracers common variables 21 16 USE sms_pisces ! PISCES Source Minus Sink variables 22 USE p4zopt ! optical model23 17 USE p4zche ! chemical model 24 18 USE p4zprod ! Growth rate of the 2 phyto groups 25 USE p4zmeso ! Sources and sinks of mesozooplankton26 USE p4zint ! interpolation and computation of various fields27 19 USE p4zlim 28 20 USE prtctl_trc ! print control for debugging … … 38 30 39 31 !! * Shared module variables 32 REAL(wp), PUBLIC :: xremikc !: remineralisation rate of DOC 33 REAL(wp), PUBLIC :: xremikn !: remineralisation rate of DON 34 REAL(wp), PUBLIC :: xremikp !: remineralisation rate of DOP 40 35 REAL(wp), PUBLIC :: xremik !: remineralisation rate of POC 41 REAL(wp), PUBLIC :: xremip !: remineralisation rate of DOC42 36 REAL(wp), PUBLIC :: nitrif !: NH4 nitrification rate 43 37 REAL(wp), PUBLIC :: xsirem !: remineralisation rate of POC 44 38 REAL(wp), PUBLIC :: xsiremlab !: fast remineralisation rate of POC 45 39 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 46 40 REAL(wp), PUBLIC :: feratb !: Fe/C quota in bacteria 41 REAL(wp), PUBLIC :: xkferb !: Half-saturation constant for bacteria Fe/C 47 42 48 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - -50 44 51 45 !!---------------------------------------------------------------------- … … 68 62 ! 69 63 INTEGER :: ji, jj, jk 70 REAL(wp) :: zremi p, zremik, zsiremin64 REAL(wp) :: zremik, zremikc, zremikn, zremikp, zsiremin, zfact 71 65 REAL(wp) :: zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 72 REAL(wp) :: zbactfer, zorem, zorem2, zofer, zolimit 73 REAL(wp) :: zosil, ztem 74 #if ! defined key_kriest 75 REAL(wp) :: zofer2 76 #endif 77 REAL(wp) :: zonitr, zstep, zfact 66 REAL(wp) :: zbactfer, zolimit, zonitr, zrfact2 67 REAL(wp) :: zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 78 68 CHARACTER (len=25) :: charout 79 69 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, z w3d70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib 81 71 !!--------------------------------------------------------------------- 82 72 ! … … 85 75 ! Allocate temporary workspace 86 76 CALL wrk_alloc( jpi, jpj, ztempbac ) 87 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )77 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 88 78 89 79 ! Initialisation of temprary arrys 90 80 zdepprod(:,:,:) = 1._wp 91 81 ztempbac(:,:) = 0._wp 82 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 83 zfacsi(:,:,:) = xsilab 92 84 93 85 ! Computation of the mean phytoplankton concentration as … … 112 104 END DO 113 105 106 IF( ln_p4z ) THEN 107 DO jk = 1, jpkm1 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 ! DOC ammonification. Depends on depth, phytoplankton biomass 111 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 112 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 113 zremik = MAX( zremik, 2.74e-4 * xstep ) 114 ! Ammonification in oxic waters with oxygen consumption 115 ! ----------------------------------------------------- 116 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 117 zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 118 ! Ammonification in suboxic waters with denitrification 119 ! ------------------------------------------------------- 120 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, & 121 & zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) ) 122 ! 123 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 124 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 125 ! 126 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 127 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 128 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 129 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) 130 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 131 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 132 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) & 133 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 134 END DO 135 END DO 136 END DO 137 ELSE 138 DO jk = 1, jpkm1 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 ! DOC ammonification. Depends on depth, phytoplankton biomass 142 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 143 ! ----------------------------------------------------------------- 144 zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 145 zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 146 147 zremikc = xremikc * zremik 148 zremikn = xremikn / xremikc 149 zremikp = xremikp / xremikc 150 151 ! Ammonification in oxic waters with oxygen consumption 152 ! ----------------------------------------------------- 153 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 154 zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) ) 155 zolimi(ji,jj,jk) = zolimic 156 zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 157 zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 158 159 ! Ammonification in suboxic waters with denitrification 160 ! ------------------------------------------------------- 161 zolimit = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 162 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, zolimit ) 163 denitr(ji,jj,jk) = MAX( 0.e0, denitr(ji,jj,jk) ) 164 zdenitrn = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 165 zdenitrp = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 166 167 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp 168 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn 169 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 170 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) 171 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn 172 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp 173 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 174 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) 175 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + ( rdenit + 1.) * zdenitrn ) 176 END DO 177 END DO 178 END DO 179 ! 180 ENDIF 181 182 114 183 DO jk = 1, jpkm1 115 184 DO jj = 1, jpj 116 185 DO ji = 1, jpi 117 zstep = xstep118 # if defined key_degrad119 zstep = zstep * facvol(ji,jj,jk)120 # endif121 ! DOC ammonification. Depends on depth, phytoplankton biomass122 ! and a limitation term which is supposed to be a parameterization123 ! of the bacterial activity.124 zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)125 zremik = MAX( zremik, 2.74e-4 * xstep )126 ! Ammonification in oxic waters with oxygen consumption127 ! -----------------------------------------------------128 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)129 zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )130 ! Ammonification in suboxic waters with denitrification131 ! -------------------------------------------------------132 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, &133 & zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) )134 !135 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )136 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )137 !138 END DO139 END DO140 END DO141 142 143 DO jk = 1, jpkm1144 DO jj = 1, jpj145 DO ji = 1, jpi146 zstep = xstep147 # if defined key_degrad148 zstep = zstep * facvol(ji,jj,jk)149 # endif150 186 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 151 187 ! below 2 umol/L. Inhibited at strong light 152 188 ! ---------------------------------------------------------- 153 zonitr =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 154 denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 189 zonitr = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) ) & 190 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 191 zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 155 192 ! Update of the tracers trends 156 193 ! ---------------------------- 157 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk)158 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk)194 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 195 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 159 196 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 160 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk)197 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 161 198 END DO 162 199 END DO … … 177 214 ! studies (especially at Papa) have shown this uptake to be significant 178 215 ! ---------------------------------------------------------- 179 zbactfer = 10.e-6* rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) &180 & * trb(ji,jj,jk,jpfer) / ( 2.5E-10+ trb(ji,jj,jk,jpfer) ) &216 zbactfer = feratb * rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) & 217 & * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) ) & 181 218 & * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 182 #if defined key_kriest183 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.05184 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.05185 #else186 219 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.16 187 220 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.12 188 221 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.04 189 #endif190 222 END DO 191 223 END DO … … 198 230 ENDIF 199 231 232 ! Initialization of the array which contains the labile fraction 233 ! of bSi. Set to a constant in the upper ocean 234 ! --------------------------------------------------------------- 235 200 236 DO jk = 1, jpkm1 201 237 DO jj = 1, jpj 202 238 DO ji = 1, jpi 203 zstep = xstep 204 # if defined key_degrad 205 zstep = zstep * facvol(ji,jj,jk) 206 # endif 207 ! POC disaggregation by turbulence and bacterial activity. 208 ! -------------------------------------------------------- 209 zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.55 * nitrfac(ji,jj,jk) ) 210 211 ! POC disaggregation rate is reduced in anoxic zone as shown by 212 ! sediment traps data. In oxic area, the exponent of the martin s 213 ! law is around -0.87. In anoxic zone, it is around -0.35. This 214 ! means a disaggregation constant about 0.5 the value in oxic zones 215 ! ----------------------------------------------------------------- 216 zorem = zremip * trb(ji,jj,jk,jppoc) 217 zofer = zremip * trb(ji,jj,jk,jpsfe) 218 #if ! defined key_kriest 219 zorem2 = zremip * trb(ji,jj,jk,jpgoc) 220 zofer2 = zremip * trb(ji,jj,jk,jpbfe) 221 #else 222 zorem2 = zremip * trb(ji,jj,jk,jpnum) 223 #endif 224 225 ! Update the appropriate tracers trends 226 ! ------------------------------------- 227 228 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 229 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 230 #if defined key_kriest 231 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 232 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2 233 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 234 #else 235 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem 236 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 237 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer 238 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 239 #endif 240 241 END DO 242 END DO 243 END DO 244 245 IF(ln_ctl) THEN ! print mean trends (used for debugging) 246 WRITE(charout, FMT="('rem3')") 247 CALL prt_ctl_trc_info(charout) 248 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 249 ENDIF 250 251 DO jk = 1, jpkm1 252 DO jj = 1, jpj 253 DO ji = 1, jpi 254 zstep = xstep 255 # if defined key_degrad 256 zstep = zstep * facvol(ji,jj,jk) 257 # endif 239 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 240 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 241 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 242 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 258 243 ! Remineralization rate of BSi depedant on T and saturation 259 244 ! --------------------------------------------------------- 260 zsatur = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 261 zsatur = MAX( rtrn, zsatur ) 262 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 263 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 264 znusil2 = 0.225 * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2 265 266 ! Two classes of BSi are considered : a labile fraction and 267 ! a more refractory one. The ratio between both fractions is 268 ! constant and specified in the namelist. 269 ! ---------------------------------------------------------- 270 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 271 zdep = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 272 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 273 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 274 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 245 IF ( gdept_n(ji,jj,jk) > zdep ) THEN 246 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 247 & * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 248 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 249 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 250 & * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 251 ENDIF 252 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 275 253 zosil = zsiremin * trb(ji,jj,jk,jpgsi) 276 254 ! … … 283 261 284 262 IF(ln_ctl) THEN ! print mean trends (used for debugging) 285 WRITE(charout, FMT="('rem 4')")263 WRITE(charout, FMT="('rem3')") 286 264 CALL prt_ctl_trc_info(charout) 287 265 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 288 266 ENDIF 289 290 ! Update the arrays TRA which contain the biological sources and sinks291 ! --------------------------------------------------------------------292 293 DO jk = 1, jpkm1294 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)295 tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)296 tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit297 tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)298 tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut299 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)300 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) )301 END DO302 267 303 268 IF( knt == nrdttrc ) THEN … … 316 281 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 317 282 ENDIF 318 319 IF(ln_ctl) THEN ! print mean trends (used for debugging)320 WRITE(charout, FMT="('rem6')")321 CALL prt_ctl_trc_info(charout)322 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)323 ENDIF324 283 ! 325 284 CALL wrk_dealloc( jpi, jpj, ztempbac ) 326 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )285 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 327 286 ! 328 287 IF( nn_timing == 1 ) CALL timing_stop('p4z_rem') … … 343 302 !! 344 303 !!---------------------------------------------------------------------- 345 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab 304 NAMELIST/nampisrem/ xremik, nitrif, xsirem, xsiremlab, xsilab, feratb, xkferb, & 305 & xremikc, xremikn, xremikp 346 306 INTEGER :: ios ! Local integer output status for namelist read 347 307 … … 359 319 WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem' 360 320 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 361 WRITE(numout,*) ' remineralisation rate of POC xremip =', xremip 362 WRITE(numout,*) ' remineralization rate of DOC xremik =', xremik 321 IF( ln_p4z ) THEN 322 WRITE(numout,*) ' remineralization rate of DOC xremik =', xremik 323 ELSE 324 WRITE(numout,*) ' remineralization rate of DOC xremikc =', xremikc 325 WRITE(numout,*) ' remineralization rate of DON xremikn =', xremikn 326 WRITE(numout,*) ' remineralization rate of DOP xremikp =', xremikp 327 ENDIF 363 328 WRITE(numout,*) ' remineralization rate of Si xsirem =', xsirem 364 329 WRITE(numout,*) ' fast remineralization rate of Si xsiremlab =', xsiremlab 365 330 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab 366 331 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif 332 WRITE(numout,*) ' Bacterial Fe/C ratio feratb =', feratb 333 WRITE(numout,*) ' Half-saturation constant for bact. Fe/C xkferb =', xkferb 367 334 ENDIF 368 335 ! 369 336 denitr (:,:,:) = 0._wp 370 denitnh4(:,:,:) = 0._wp371 337 ! 372 338 END SUBROUTINE p4z_rem_init … … 377 343 !! *** ROUTINE p4z_rem_alloc *** 378 344 !!---------------------------------------------------------------------- 379 ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk),STAT=p4z_rem_alloc )345 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 380 346 ! 381 347 IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 382 348 ! 383 349 END FUNCTION p4z_rem_alloc 384 385 #else386 !!======================================================================387 !! Dummy module : No PISCES bio-model388 !!======================================================================389 CONTAINS390 SUBROUTINE p4z_rem ! Empty routine391 END SUBROUTINE p4z_rem392 #endif393 350 394 351 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r6962 r7403 5 5 !!====================================================================== 6 6 !! History : 3.5 ! 2012-07 (O. Aumont, C. Ethe) Original code 7 !!----------------------------------------------------------------------8 #if defined key_pisces9 !!----------------------------------------------------------------------10 !! 'key_pisces' PISCES bio-model11 7 !!---------------------------------------------------------------------- 12 8 !! p4z_sbc : Read and interpolate time-varying nutrients fluxes … … 41 37 REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs 42 38 REAL(wp) :: hratio !: Fe:3He ratio assumed for vent iron supply 39 REAL(wp), PUBLIC :: fep_rats !: Fep/Fer ratio from sed sources 40 REAL(wp), PUBLIC :: fep_rath !: Fep/Fer ratio from hydro sources 41 REAL(wp), PUBLIC :: lgw_rath !: Weak ligand ratio from hydro sources 42 43 43 44 44 LOGICAL , PUBLIC :: ll_sbc … … 70 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdic, rivalk !: river input fields 71 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdin, rivdip !: river input fields 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdon, rivdop !: river input fields 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdoc !: river input fields 72 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdsi !: river input fields 73 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep !: atmospheric N deposition … … 134 136 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 135 137 CALL fld_read( kt, 1, sf_river ) 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 139 rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) & 140 & * 1.E3 / ( 12. * zcoef + rtrn ) 141 rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) & 142 & * 1.E3 / ( 12. * zcoef + rtrn ) 143 rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) & 144 & * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 145 rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) & 146 & * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 147 rivdsi(ji,jj) = sf_river(jr_dsi)%fnow(ji,jj,1) & 148 & * 1.E3 / ( 28.1 * zcoef + rtrn ) 138 IF( ln_p4z ) THEN 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 142 rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) & 143 & * 1.E3 / ( 12. * zcoef + rtrn ) 144 rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) & 145 & * 1.E3 / ( 12. * zcoef + rtrn ) 146 rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) & 147 & * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 148 rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) & 149 & * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 150 rivdsi(ji,jj) = sf_river(jr_dsi)%fnow(ji,jj,1) & 151 & * 1.E3 / ( 28.1 * zcoef + rtrn ) 152 END DO 149 153 END DO 150 END DO 154 ELSE ! ln_p5z 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 158 rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) & 159 & * 1.E3 / ( 12. * zcoef + rtrn ) 160 rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) & 161 & * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 162 rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) & 163 & * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 164 rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) & 165 & * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 166 rivdoc(ji,jj) = ( sf_river(jr_doc)%fnow(ji,jj,1) ) & 167 & * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 168 rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) & 169 & * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 170 rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) & 171 & * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 172 END DO 173 END DO 174 ENDIF 151 175 ENDIF 152 176 ENDIF … … 205 229 & sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & 206 230 & ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe, & 207 & sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, hratio 231 & sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, & 232 & hratio, fep_rats, fep_rath, lgw_rath 208 233 !!---------------------------------------------------------------------- 209 234 ! … … 249 274 WRITE(numout,*) ' fe half-saturation cste for diazotrophs concfediaz = ', concfediaz 250 275 WRITE(numout,*) ' Fe to 3He ratio assumed for vent iron supply hratio = ', hratio 276 IF( ln_ligand ) THEN 277 WRITE(numout,*) ' Fep/Fer ratio from sed sources fep_rats = ', fep_rats 278 WRITE(numout,*) ' Fep/Fer ratio from sed hydro sources fep_rath = ', fep_rath 279 WRITE(numout,*) ' Weak ligand ratio from sed hydro sources lgw_rath = ', lgw_rath 280 ENDIF 251 281 END IF 252 282 … … 291 321 END DO 292 322 CALL iom_close( numdust ) 293 ztimes_dust = 1._wp / FLOAT( ntimes_dust)323 ztimes_dust = 1._wp / REAL(ntimes_dust, wp) 294 324 sumdepsi = 0.e0 295 325 DO jm = 1, ntimes_dust … … 334 364 ! 335 365 ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) ) 366 IF( ln_p5z ) ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) ) 336 367 ! 337 368 ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 ) !* allocate and fill sf_river (forcing structure) with sn_river_ … … 355 386 END DO 356 387 CALL iom_close( numriv ) 357 ztimes_riv = 1._wp / FLOAT(ntimes_riv)388 ztimes_riv = 1._wp / REAL(ntimes_riv, wp) 358 389 DO jm = 1, ntimes_riv 359 390 rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) … … 402 433 END DO 403 434 CALL iom_close( numdepo ) 404 ztimes_ndep = 1._wp / FLOAT( ntimes_ndep)435 ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp) 405 436 nitdepinput = 0._wp 406 437 DO jm = 1, ntimes_ndep … … 508 539 END SUBROUTINE p4z_sbc_init 509 540 510 #else511 !!======================================================================512 !! Dummy module : No PISCES bio-model513 !!======================================================================514 CONTAINS515 SUBROUTINE p4z_sbc ! Empty routine516 END SUBROUTINE p4z_sbc517 #endif518 519 541 !!====================================================================== 520 542 END MODULE p4zsbc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r6140 r7403 9 9 !! 3.5 ! 2012-07 (O. Aumont) improvment of river input of nutrients 10 10 !!---------------------------------------------------------------------- 11 #if defined key_pisces12 !!----------------------------------------------------------------------13 !! 'key_pisces' PISCES bio-model14 !!----------------------------------------------------------------------15 11 !! p4z_sed : Compute loss of organic matter in the sediments 16 12 !!---------------------------------------------------------------------- … … 18 14 USE trc ! passive tracers common variables 19 15 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zsink ! vertical flux of particulate matter due to sinking21 USE p4zopt ! optical model22 16 USE p4zlim ! Co-limitations of differents nutrients 23 17 USE p4zsbc ! External source of nutrients … … 56 50 INTEGER, INTENT(in) :: kt, knt ! ocean time step 57 51 INTEGER :: ji, jj, jk, ikt 58 #if ! defined key_sed59 52 REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal 60 53 REAL(wp) :: zrivalk, zrivsil, zrivno3 61 #endif62 54 REAL(wp) :: zwflux, zfminus, zfplus 63 55 REAL(wp) :: zlim, zfact, zfactcal 64 56 REAL(wp) :: zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit 65 REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc 66 REAL(wp) :: ztrfer, ztrpo4, zwdust, zlight 57 REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep 58 REAL(wp) :: zwstpoc, zwstpon, zwstpop 59 REAL(wp) :: ztrfer, ztrpo4s, ztrdp, zwdust, zmudia, ztemp 60 REAL(wp) :: xdiano3, xdianh4 61 REAL(wp) :: zwssfep 67 62 ! 68 63 CHARACTER (len=25) :: charout 69 REAL(wp), POINTER, DIMENSION(:,: ) :: z pdep, zsidep, zwork1, zwork2, zwork364 REAL(wp), POINTER, DIMENSION(:,: ) :: zsidep, zwork1, zwork2, zwork3 70 65 REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff 71 66 REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer 67 REAL(wp), POINTER, DIMENSION(:,: ) :: zsedcal, zsedsi, zsedc 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zwsfep 70 73 71 !!--------------------------------------------------------------------- 74 72 ! … … 78 76 ! 79 77 ! Allocate temporary workspace 80 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 81 CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 82 CALL wrk_alloc( jpi, jpj, jpk, zsoufer ) 78 CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 79 CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 80 CALL wrk_alloc( jpi, jpj, zsedcal, zsedsi, zsedc ) 81 CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer ) 82 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 83 IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep ) 84 83 85 84 86 zdenit2d(:,:) = 0.e0 … … 87 89 zwork2 (:,:) = 0.e0 88 90 zwork3 (:,:) = 0.e0 91 zsedsi (:,:) = 0.e0 92 zsedcal (:,:) = 0.e0 93 zsedc (:,:) = 0.e0 94 89 95 90 96 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. … … 117 123 IF( ln_dust ) THEN 118 124 ! 119 CALL wrk_alloc( jpi, jpj, z pdep, zsidep )120 CALL wrk_alloc( jpi, jpj, jpk, z irondep )125 CALL wrk_alloc( jpi, jpj, zsidep ) 126 CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep ) 121 127 ! ! Iron and Si deposition at the surface 122 128 IF( ln_solub ) THEN … … 125 131 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 126 132 ENDIF 127 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1128 zpdep (:,: ) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r133 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 134 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 129 135 ! ! Iron solubilization of particles in the water column 130 136 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j … … 132 138 DO jk = 2, jpkm1 133 139 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 134 141 END DO 135 142 ! ! Iron solubilization of particles in the water column 136 tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep (:,:)137 143 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 144 tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep (:,:,:) 138 145 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 139 146 ! … … 145 152 & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface 146 153 ENDIF 147 ELSE148 IF( ln_diatrc ) &149 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)150 154 ENDIF 151 CALL wrk_dealloc( jpi, jpj, z pdep, zsidep )152 CALL wrk_dealloc( jpi, jpj, jpk, z irondep )155 CALL wrk_dealloc( jpi, jpj, zsidep ) 156 CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep ) 153 157 ! 154 158 ENDIF … … 169 173 ENDDO 170 174 ENDDO 175 IF( ln_p5z ) THEN 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 DO jk = 1, nk_rnf(ji,jj) 179 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 180 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 181 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2 182 ENDDO 183 ENDDO 184 ENDDO 185 ENDIF 171 186 ENDIF 172 187 … … 181 196 ! ------------------------------------------------------ 182 197 IF( ln_ironsed ) THEN 183 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 198 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 199 IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 184 200 ! 185 201 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 190 206 ! ------------------------------------------------------ 191 207 IF( ln_hydrofe ) THEN 192 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 208 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 209 IF( ln_ligand ) THEN 210 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 211 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 212 ENDIF 193 213 ! 194 214 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) ) & … … 196 216 ENDIF 197 217 198 ! OA: Warning, the following part is necessary, especially with Kriest 199 ! to avoid CFL problems above the sediments 218 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 200 219 ! -------------------------------------------------------------------- 201 220 DO jj = 1, jpj … … 208 227 END DO 209 228 END DO 210 211 #if ! defined key_sed 212 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 213 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 214 ! ------------------------------------------------------- 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 IF( tmask(ji,jj,1) == 1 ) THEN 218 ikt = mbkt(ji,jj) 219 # if defined key_kriest 220 zflx = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4 221 # else 222 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 223 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 224 #endif 225 zflx = LOG10( MAX( 1E-3, zflx ) ) 226 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 227 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 228 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 229 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 230 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 231 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 232 ! 233 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 234 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 235 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 236 ENDIF 237 END DO 238 END DO 239 240 ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 241 ! First, the total loss is computed. 242 ! The factor for calcite comes from the alkalinity effect 243 ! ------------------------------------------------------------- 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 IF( tmask(ji,jj,1) == 1 ) THEN 247 ikt = mbkt(ji,jj) 248 # if defined key_kriest 249 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 250 zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 251 # else 252 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 253 zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 254 # endif 255 ! For calcite, burial efficiency is made a function of saturation 256 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 257 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 258 zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 259 ENDIF 260 END DO 261 END DO 262 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 263 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 264 zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 265 #endif 229 ! 230 IF( ln_ligand ) THEN 231 DO jj = 1, jpj 232 DO ji = 1, jpi 233 ikt = mbkt(ji,jj) 234 zdep = e3t_n(ji,jj,ikt) / xstep 235 zwsfep(ji,jj) = MIN( 0.99 * zdep, wsfep(ji,jj,ikt) ) 236 END DO 237 ENDDO 238 ENDIF 239 240 IF( .NOT.lk_sed ) THEN 241 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 242 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 243 ! ------------------------------------------------------- 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 IF( tmask(ji,jj,1) == 1 ) THEN 247 ikt = mbkt(ji,jj) 248 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 249 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 250 zflx = LOG10( MAX( 1E-3, zflx ) ) 251 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 252 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 253 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 254 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 255 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 256 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 257 ! 258 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 259 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 260 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 261 ENDIF 262 END DO 263 END DO 264 265 ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 266 ! First, the total loss is computed. 267 ! The factor for calcite comes from the alkalinity effect 268 ! ------------------------------------------------------------- 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 IF( tmask(ji,jj,1) == 1 ) THEN 272 ikt = mbkt(ji,jj) 273 zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 274 zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 275 ! For calcite, burial efficiency is made a function of saturation 276 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 277 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 278 zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 279 ENDIF 280 END DO 281 END DO 282 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 283 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 284 zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 285 ! 286 ENDIF 266 287 267 288 ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean. 268 289 ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers) 269 290 ! ------------------------------------------------------ 270 #if ! defined key_sed 271 zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 272 #endif 291 IF( .NOT.lk_sed ) zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 273 292 274 293 DO jj = 1, jpj … … 276 295 ikt = mbkt(ji,jj) 277 296 zdep = xstep / e3t_n(ji,jj,ikt) 278 zws4 = zwsbio4(ji,jj) * zdep279 297 zwsc = zwscal (ji,jj) * zdep 280 # if defined key_kriest281 zsiloss = trb(ji,jj,ikt,jpgsi) * zws4282 # else283 298 zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 284 # endif285 299 zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 286 300 ! 287 301 tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 288 302 tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 289 #if ! defined key_sed290 tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil291 zfactcal = MIN( excess(ji,jj,ikt), 0.2 )292 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )293 zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )294 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0295 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk296 #endif297 303 END DO 298 304 END DO 299 305 ! 306 IF( .NOT.lk_sed ) THEN 307 DO jj = 1, jpj 308 DO ji = 1, jpi 309 ikt = mbkt(ji,jj) 310 zdep = xstep / e3t_n(ji,jj,ikt) 311 zwsc = zwscal (ji,jj) * zdep 312 zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 313 zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 314 tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 315 ! 316 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 317 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 318 zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 319 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 320 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 321 zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep 322 zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep 323 END DO 324 END DO 325 ENDIF 326 ! 300 327 DO jj = 1, jpj 301 328 DO ji = 1, jpi … … 304 331 zws4 = zwsbio4(ji,jj) * zdep 305 332 zws3 = zwsbio3(ji,jj) * zdep 306 zrivno3 = 1. - zbureff(ji,jj)307 # if ! defined key_kriest308 333 tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 309 334 tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 310 335 tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 311 336 tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 312 zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3313 # else314 tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4315 tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3316 tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3317 zwstpoc = trb(ji,jj,ikt,jppoc) * zws3318 # endif319 320 #if ! defined key_sed321 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification322 ! in the sediments and just above the sediments. Not very clever, but simpliest option.323 zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )324 z1pdenit = zwstpoc * zrivno3 - zpdenit325 zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )326 zdenitt = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )327 tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt328 tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt329 tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt330 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)331 tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut332 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )333 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt334 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)335 #endif336 337 END DO 337 338 END DO 339 ! 340 IF( ln_ligand ) THEN 341 DO jj = 1, jpj 342 DO ji = 1, jpi 343 ikt = mbkt(ji,jj) 344 zdep = xstep / e3t_n(ji,jj,ikt) 345 zwssfep = zwsfep(ji,jj) * zdep 346 tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trb(ji,jj,ikt,jpfep) * zwssfep 347 END DO 348 END DO 349 ENDIF 350 ! 351 IF( ln_p5z ) THEN 352 DO jj = 1, jpj 353 DO ji = 1, jpi 354 ikt = mbkt(ji,jj) 355 zdep = xstep / e3t_n(ji,jj,ikt) 356 zws4 = zwsbio4(ji,jj) * zdep 357 zws3 = zwsbio3(ji,jj) * zdep 358 tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 359 tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 360 tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 361 tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 362 END DO 363 END DO 364 ENDIF 365 366 IF( .NOT.lk_sed ) THEN 367 ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 368 ! in the sediments and just above the sediments. Not very clever, but simpliest option. 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 ikt = mbkt(ji,jj) 372 zdep = xstep / e3t_n(ji,jj,ikt) 373 zws4 = zwsbio4(ji,jj) * zdep 374 zws3 = zwsbio3(ji,jj) * zdep 375 zrivno3 = 1. - zbureff(ji,jj) 376 zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 377 zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 378 z1pdenit = zwstpoc * zrivno3 - zpdenit 379 zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 380 zdenitt = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 381 tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 382 tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 383 tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 384 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 385 tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 386 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 387 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 388 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 389 zsedc(ji,jj) = (1. - zrivno3) * zwstpoc / zdep 390 IF( ln_p5z ) THEN 391 zwstpop = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 392 zwstpon = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 393 tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + (z1pdenit - zolimit - zdenitt) * zwstpon / (zwstpoc + rtrn) 394 tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + (z1pdenit - zolimit - zdenitt) * zwstpop / (zwstpoc + rtrn) 395 ENDIF 396 END DO 397 END DO 398 ENDIF 399 338 400 339 401 ! Nitrogen fixation process … … 341 403 !----------------------------------- 342 404 DO jk = 1, jpkm1 343 DO jj = 1, jpj 344 DO ji = 1, jpi 345 ! ! Potential nitrogen fixation dependant on temperature and iron 346 zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 347 IF( zlim <= 0.2 ) zlim = 0.01 348 #if defined key_degrad 349 zfact = zlim * rfact2 * facvol(ji,jj,jk) 350 #else 351 zfact = zlim * rfact2 352 #endif 353 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 354 ztrpo4 = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) ) 355 zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 356 nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 357 & * zfact * MIN( ztrfer, ztrpo4 ) * zlight 358 zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk)) 359 END DO 360 END DO 361 END DO 405 zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 406 zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 407 ENDDO 408 IF( ln_p4z ) THEN 409 DO jk = 1, jpkm1 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 ! ! Potential nitrogen fixation dependant on temperature and iron 413 zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 414 IF( zlim <= 0.2 ) zlim = 0.01 415 zfact = zlim * rfact2 416 417 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 418 ztrpo4s = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) ) 419 nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 420 & * zfact * MIN( ztrfer, ztrpo4s ) * zlight(ji,jj,jk) 421 END DO 422 END DO 423 END DO 424 ELSE ! p5z 425 DO jk = 1, jpkm1 426 DO jj = 1, jpj 427 DO ji = 1, jpi 428 ! ! Potential nitrogen fixation dependant on temperature and iron 429 ztemp = tsn(ji,jj,jk,jp_tem) 430 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 431 ! Potential nitrogen fixation dependant on temperature and iron 432 xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 433 xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 434 zlim = ( 1.- xdiano3 - xdianh4 ) 435 IF( zlim <= 0.1 ) zlim = 0.01 436 zfact = zlim * rfact2 437 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 438 ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 439 ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 440 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 441 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 442 END DO 443 END DO 444 END DO 445 ENDIF 362 446 363 447 ! Nitrogen change due to nitrogen fixation 364 448 ! ---------------------------------------- 365 DO jk = 1, jpkm1 366 DO jj = 1, jpj 367 DO ji = 1, jpi 368 zfact = nitrpot(ji,jj,jk) * nitrfix 369 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact 370 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact 371 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact 372 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 373 & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 374 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 375 END DO 376 END DO 377 END DO 449 IF( ln_p4z ) THEN 450 DO jk = 1, jpkm1 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 zfact = nitrpot(ji,jj,jk) * nitrfix 454 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact 455 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact 456 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact 457 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 458 & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 459 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 460 END DO 461 END DO 462 END DO 463 ELSE ! p5z 464 DO jk = 1, jpkm1 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 zfact = nitrpot(ji,jj,jk) * nitrfix 468 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 469 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 470 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 471 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 472 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 473 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 474 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0 & 475 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 476 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 477 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 478 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 479 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 480 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 481 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 482 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 483 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 484 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 485 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 486 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 487 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 488 END DO 489 END DO 490 END DO 491 ! 492 ENDIF 378 493 379 494 IF( lk_iomput ) THEN … … 388 503 CALL iom_put( "INTNFIX" , zwork1 ) 389 504 ENDIF 505 IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 ) 506 IF( iom_use("SedSi" ) ) CALL iom_put( "SedSi", zsedsi (:,:) * 1.e+3 ) 507 IF( iom_use("SedC" ) ) CALL iom_put( "SedC", zsedc (:,:) * 1.e+3 ) 508 IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 ) 390 509 ENDIF 391 ELSE392 IF( ln_diatrc ) &393 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)394 510 ENDIF 395 511 ! … … 400 516 ENDIF 401 517 ! 402 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 403 CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 404 CALL wrk_dealloc( jpi, jpj, jpk, zsoufer ) 518 CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 519 CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 520 CALL wrk_dealloc( jpi, jpj, zsedcal, zsedsi, zsedc ) 521 CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer ) 522 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 523 IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep ) 405 524 ! 406 525 IF( nn_timing == 1 ) CALL timing_stop('p4z_sed') 407 !408 9100 FORMAT(i8,3f10.5)409 526 ! 410 527 END SUBROUTINE p4z_sed … … 422 539 423 540 424 #else425 !!======================================================================426 !! Dummy module : No PISCES bio-model427 !!======================================================================428 CONTAINS429 SUBROUTINE p4z_sed ! Empty routine430 END SUBROUTINE p4z_sed431 #endif432 433 541 !!====================================================================== 434 542 END MODULE p4zsed -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r6140 r7403 9 9 !! 3.5 ! 2012-07 (O. Aumont) Introduce potential time-splitting 10 10 !!---------------------------------------------------------------------- 11 #if defined key_pisces12 !!----------------------------------------------------------------------13 11 !! p4z_sink : Compute vertical flux of particulate matter due to gravitational sinking 14 12 !! p4z_sink_init : Unitialisation of sinking speed parameters … … 29 27 PUBLIC p4z_sink_alloc 30 28 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3 !: POC sinking speed32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4 !: GOC sinking speed33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal !: Calcite and BSi sinking speeds34 35 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinking, sinking2 !: POC sinking fluxes 36 30 ! ! (different meanings depending on the parameterization) 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkingn, sinking2n !: POC sinking fluxes 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkingp, sinking2p !: POC sinking fluxes 37 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkcal, sinksil !: CaCO3 and BSi sinking fluxes 38 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer !: Small BFe sinking fluxes 39 #if ! defined key_kriest40 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2 !: Big iron sinking fluxes 41 #endif 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfep !: Fep sinking fluxes 42 37 43 38 INTEGER :: ik100 44 45 #if defined key_kriest46 REAL(wp) :: xkr_sfact !: Sinking factor47 REAL(wp) :: xkr_stick !: Stickiness48 REAL(wp) :: xkr_nnano !: Nbr of cell in nano size class49 REAL(wp) :: xkr_ndiat !: Nbr of cell in diatoms size class50 REAL(wp) :: xkr_nmicro !: Nbr of cell in microzoo size class51 REAL(wp) :: xkr_nmeso !: Nbr of cell in mesozoo size class52 REAL(wp) :: xkr_naggr !: Nbr of cell in aggregates size class53 54 REAL(wp) :: xkr_frac55 56 REAL(wp), PUBLIC :: xkr_dnano !: Size of particles in nano pool57 REAL(wp), PUBLIC :: xkr_ddiat !: Size of particles in diatoms pool58 REAL(wp), PUBLIC :: xkr_dmicro !: Size of particles in microzoo pool59 REAL(wp), PUBLIC :: xkr_dmeso !: Size of particles in mesozoo pool60 REAL(wp), PUBLIC :: xkr_daggr !: Size of particles in aggregates pool61 REAL(wp), PUBLIC :: xkr_wsbio_min !: min vertical particle speed62 REAL(wp), PUBLIC :: xkr_wsbio_max !: max vertical particle speed63 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm !: maximum number of particles in aggregates65 #endif66 39 67 40 !!---------------------------------------------------------------------- … … 72 45 CONTAINS 73 46 74 #if ! defined key_kriest75 47 !!---------------------------------------------------------------------- 76 48 !! 'standard sinking parameterisation' ??? … … 91 63 REAL(wp) :: zagg1, zagg2, zagg3, zagg4 92 64 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 93 REAL(wp) :: zfact, zwsmax, zmax , zstep65 REAL(wp) :: zfact, zwsmax, zmax 94 66 CHARACTER (len=25) :: charout 95 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d … … 98 70 ! 99 71 IF( nn_timing == 1 ) CALL timing_start('p4z_sink') 72 73 74 ! Initialization of some global variables 75 ! --------------------------------------- 76 prodpoc(:,:,:) = 0. 77 conspoc(:,:,:) = 0. 78 prodgoc(:,:,:) = 0. 79 consgoc(:,:,:) = 0. 80 100 81 ! 101 82 ! Sinking speeds of detritus is increased with depth as shown … … 105 86 DO jj = 1, jpj 106 87 DO ji = 1,jpi 107 zmax = MAX( heup (ji,jj), hmld(ji,jj) )108 zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp109 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2) * zfact88 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 89 zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 90 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 110 91 END DO 111 92 END DO … … 114 95 ! limit the values of the sinking speeds to avoid numerical instabilities 115 96 wsbio3(:,:,:) = wsbio 116 wscal (:,:,:) = wsbio4(:,:,:) 97 117 98 ! 118 99 ! OA This is (I hope) a temporary solution for the problem that may … … 155 136 IF( tmask(ji,jj,jk) == 1 ) THEN 156 137 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 157 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1) )158 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2) )138 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * REAL( iiter1, wp ) ) 139 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * REAL( iiter2, wp ) ) 159 140 ENDIF 160 141 END DO 161 142 END DO 162 143 END DO 144 145 wscal (:,:,:) = wsbio4(:,:,:) 163 146 164 147 ! Initializa to zero all the sinking arrays … … 185 168 END DO 186 169 187 ! Exchange between organic matter compartments due to coagulation/disaggregation 188 ! --------------------------------------------------- 189 DO jk = 1, jpkm1 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ! 193 zstep = xstep 194 # if defined key_degrad 195 zstep = zstep * facvol(ji,jj,jk) 196 # endif 197 zfact = zstep * xdiss(ji,jj,jk) 198 ! Part I : Coagulation dependent on turbulence 199 zagg1 = 25.9 * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 200 zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 201 202 ! Part II : Differential settling 203 204 ! Aggregation of small into large particles 205 zagg3 = 47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 206 zagg4 = 3.3 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 207 208 zagg = zagg1 + zagg2 + zagg3 + zagg4 209 zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 210 211 ! Aggregation of DOC to POC : 212 ! 1st term is shear aggregation of DOC-DOC 213 ! 2nd term is shear aggregation of DOC-POC 214 ! 3rd term is differential settling of DOC-POC 215 zaggdoc = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact & 216 & + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 217 ! transfer of DOC to GOC : 218 ! 1st term is shear aggregation 219 ! 2nd term is differential settling 220 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 221 ! tranfer of DOC to POC due to brownian motion 222 zaggdoc3 = ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc) 223 224 ! Update the trends 225 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 226 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 227 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 228 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 229 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 230 ! 231 END DO 232 END DO 233 END DO 234 170 IF( ln_p5z ) THEN 171 sinkingn (:,:,:) = 0.e0 172 sinking2n(:,:,:) = 0.e0 173 sinkingp (:,:,:) = 0.e0 174 sinking2p(:,:,:) = 0.e0 175 176 ! Compute the sedimentation term using p4zsink2 for all the sinking particles 177 ! ----------------------------------------------------- 178 DO jit = 1, iiter1 179 CALL p4z_sink2( wsbio3, sinkingn , jppon, iiter1 ) 180 CALL p4z_sink2( wsbio3, sinkingp , jppop, iiter1 ) 181 END DO 182 183 DO jit = 1, iiter2 184 CALL p4z_sink2( wsbio4, sinking2n, jpgon, iiter2 ) 185 CALL p4z_sink2( wsbio4, sinking2p, jpgop, iiter2 ) 186 END DO 187 ENDIF 188 189 IF( ln_ligand ) THEN 190 wsfep (:,:,:) = wfep 191 DO jk = 1,jpkm1 192 DO jj = 1, jpj 193 DO ji = 1, jpi 194 IF( tmask(ji,jj,jk) == 1 ) THEN 195 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 196 wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * REAL( iiter1, wp ) ) 197 ENDIF 198 END DO 199 END DO 200 END DO 201 ! 202 sinkfep(:,:,:) = 0.e0 203 DO jit = 1, iiter1 204 CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) 205 END DO 206 ENDIF 235 207 236 208 ! Total carbon export per year … … 281 253 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 282 254 ENDIF 283 ELSE284 IF( ln_diatrc ) THEN285 zfact = 1.e3 * rfact2r286 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1)287 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1)288 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1)289 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik100) * zfact * tmask(:,:,1)290 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik100) * zfact * tmask(:,:,1)291 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1)292 ENDIF293 255 ENDIF 294 256 ! … … 320 282 ! 321 283 END SUBROUTINE p4z_sink_init 322 323 #else324 !!----------------------------------------------------------------------325 !! 'Kriest sinking parameterisation' key_kriest ???326 !!----------------------------------------------------------------------327 328 SUBROUTINE p4z_sink ( kt, knt )329 !!---------------------------------------------------------------------330 !! *** ROUTINE p4z_sink ***331 !!332 !! ** Purpose : Compute vertical flux of particulate matter due to333 !! gravitational sinking - Kriest parameterization334 !!335 !! ** Method : - ???336 !!---------------------------------------------------------------------337 !338 INTEGER, INTENT(in) :: kt, knt339 !340 INTEGER :: ji, jj, jk, jit, niter1, niter2341 REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zfract, zaggsi, zaggsh342 REAL(wp) :: zagg , zaggdoc, zaggdoc1, znumdoc343 REAL(wp) :: znum , zeps, zfm, zgm, zsm344 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5345 REAL(wp) :: zval1, zval2, zval3, zval4346 REAL(wp) :: zfact347 INTEGER :: ik1348 CHARACTER (len=25) :: charout349 REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d350 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d351 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d352 !!---------------------------------------------------------------------353 !354 IF( nn_timing == 1 ) CALL timing_start('p4z_sink')355 !356 CALL wrk_alloc( jpi, jpj, jpk, znum3d )357 !358 ! Initialisation of variables used to compute Sinking Speed359 ! ---------------------------------------------------------360 361 znum3d(:,:,:) = 0.e0362 zval1 = 1. + xkr_zeta363 zval2 = 1. + xkr_zeta + xkr_eta364 zval3 = 1. + xkr_eta365 366 ! Computation of the vertical sinking speed : Kriest et Evans, 2000367 ! -----------------------------------------------------------------368 369 DO jk = 1, jpkm1370 DO jj = 1, jpj371 DO ji = 1, jpi372 IF( tmask(ji,jj,jk) /= 0.e0 ) THEN373 znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp374 ! -------------- To avoid sinking speed over 50 m/day -------375 znum = MIN( xnumm(jk), znum )376 znum = MAX( 1.1 , znum )377 znum3d(ji,jj,jk) = znum378 !------------------------------------------------------------379 zeps = ( zval1 * znum - 1. )/ ( znum - 1. )380 zfm = xkr_frac**( 1. - zeps )381 zgm = xkr_frac**( zval1 - zeps )382 zdiv = MAX( 1.e-4, ABS( zeps - zval2 ) ) * SIGN( 1., ( zeps - zval2 ) )383 zdiv1 = zeps - zval3384 wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv &385 & - xkr_wsbio_max * zgm * xkr_eta / zdiv386 wsbio4(ji,jj,jk) = xkr_wsbio_min * ( zeps-1. ) / zdiv1 &387 & - xkr_wsbio_max * zfm * xkr_eta / zdiv1388 IF( znum == 1.1) wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk)389 ENDIF390 END DO391 END DO392 END DO393 394 wscal(:,:,:) = MAX( wsbio3(:,:,:), 30._wp )395 396 ! INITIALIZE TO ZERO ALL THE SINKING ARRAYS397 ! -----------------------------------------398 399 sinking (:,:,:) = 0.e0400 sinking2(:,:,:) = 0.e0401 sinkcal (:,:,:) = 0.e0402 sinkfer (:,:,:) = 0.e0403 sinksil (:,:,:) = 0.e0404 405 ! Compute the sedimentation term using p4zsink2 for all the sinking particles406 ! -----------------------------------------------------407 408 niter1 = niter1max409 niter2 = niter2max410 411 DO jit = 1, niter1412 CALL p4z_sink2( wsbio3, sinking , jppoc, niter1 )413 CALL p4z_sink2( wsbio3, sinkfer , jpsfe, niter1 )414 CALL p4z_sink2( wscal , sinksil , jpgsi, niter1 )415 CALL p4z_sink2( wscal , sinkcal , jpcal, niter1 )416 END DO417 418 DO jit = 1, niter2419 CALL p4z_sink2( wsbio4, sinking2, jpnum, niter2 )420 END DO421 422 ! Exchange between organic matter compartments due to coagulation/disaggregation423 ! ---------------------------------------------------424 425 zval1 = 1. + xkr_zeta426 zval2 = 1. + xkr_eta427 zval3 = 3. + xkr_eta428 zval4 = 4. + xkr_eta429 430 DO jk = 1,jpkm1431 DO jj = 1,jpj432 DO ji = 1,jpi433 IF( tmask(ji,jj,jk) /= 0.e0 ) THEN434 435 znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp436 !-------------- To avoid sinking speed over 50 m/day -------437 znum = min(xnumm(jk),znum)438 znum = MAX( 1.1,znum)439 !------------------------------------------------------------440 zeps = ( zval1 * znum - 1.) / ( znum - 1.)441 zdiv = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 )442 zdiv1 = MAX( 1.e-4, ABS( zeps - 4. ) ) * SIGN( 1., zeps - 4. )443 zdiv2 = zeps - 2.444 zdiv3 = zeps - 3.445 zdiv4 = zeps - zval2446 zdiv5 = 2.* zeps - zval4447 zfm = xkr_frac**( 1.- zeps )448 zsm = xkr_frac**xkr_eta449 450 ! Part I : Coagulation dependant on turbulence451 ! ----------------------------------------------452 453 zagg1 = 0.163 * trb(ji,jj,jk,jpnum)**2 &454 & * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3) &455 & * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min) &456 & * (zfm*xkr_mass_max**2-xkr_mass_min**2) &457 & * (zeps-1.)**2/(zdiv2*zdiv3))458 zagg2 = 2*0.163*trb(ji,jj,jk,jpnum)**2*zfm* &459 & ((xkr_mass_max**3+3.*(xkr_mass_max**2 &460 & *xkr_mass_min*(zeps-1.)/zdiv2 &461 & +xkr_mass_max*xkr_mass_min**2*(zeps-1.)/zdiv3) &462 & +xkr_mass_min**3*(zeps-1)/zdiv1) &463 & -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/ &464 & (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))465 466 zagg3 = 0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3467 468 ! Aggregation of small into large particles469 ! Part II : Differential settling470 ! ----------------------------------------------471 472 zagg4 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2* &473 & xkr_wsbio_min*(zeps-1.)**2 &474 & *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4) &475 & -(1.-zfm)/(zdiv*(zeps-1.)))- &476 & ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2) &477 & *xkr_eta)/(zdiv*zdiv3*zdiv5) )478 479 zagg5 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2 &480 & *(zeps-1.)*zfm*xkr_wsbio_min &481 & *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2) &482 & /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2) &483 & /zdiv)484 485 !486 ! Fractionnation by swimming organisms487 ! ------------------------------------488 489 zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum) &490 & * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2 &491 & * 10000.*xstep492 493 ! Aggregation of DOC to small particles494 ! --------------------------------------495 496 zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) &497 & + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc)498 zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) &499 & + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc)500 501 # if defined key_degrad502 zagg1 = zagg1 * facvol(ji,jj,jk)503 zagg2 = zagg2 * facvol(ji,jj,jk)504 zagg3 = zagg3 * facvol(ji,jj,jk)505 zagg4 = zagg4 * facvol(ji,jj,jk)506 zagg5 = zagg5 * facvol(ji,jj,jk)507 zaggdoc = zaggdoc * facvol(ji,jj,jk)508 zaggdoc1 = zaggdoc1 * facvol(ji,jj,jk)509 # endif510 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000.511 zaggsi = ( zagg4 + zagg5 ) * xstep / 10.512 zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )513 !514 znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )515 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1516 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg517 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc1518 519 ENDIF520 END DO521 END DO522 END DO523 524 ! Total primary production per year525 t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:,ik100) * e1e2t(:,:) * tmask(:,:,1) )526 !527 IF( lk_iomput ) THEN528 IF( knt == nrdttrc ) THEN529 CALL wrk_alloc( jpi, jpj, zw2d )530 CALL wrk_alloc( jpi, jpj, jpk, zw3d )531 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s532 !533 IF( iom_use( "EPC100" ) ) THEN534 zw2d(:,:) = sinking(:,:,ik100) * zfact * tmask(:,:,1) ! Export of carbon at 100m535 CALL iom_put( "EPC100" , zw2d )536 ENDIF537 IF( iom_use( "EPN100" ) ) THEN538 zw2d(:,:) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) ! Export of number of aggregates ?539 CALL iom_put( "EPN100" , zw2d )540 ENDIF541 IF( iom_use( "EPCAL100" ) ) THEN542 zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m543 CALL iom_put( "EPCAL100" , zw2d )544 ENDIF545 IF( iom_use( "EPSI100" ) ) THEN546 zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m547 CALL iom_put( "EPSI100" , zw2d )548 ENDIF549 IF( iom_use( "EXPC" ) ) THEN550 zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column551 CALL iom_put( "EXPC" , zw3d )552 ENDIF553 IF( iom_use( "EXPN" ) ) THEN554 zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column555 CALL iom_put( "EXPN" , zw3d )556 ENDIF557 IF( iom_use( "EXPCAL" ) ) THEN558 zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite559 CALL iom_put( "EXPCAL" , zw3d )560 ENDIF561 IF( iom_use( "EXPSI" ) ) THEN562 zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica563 CALL iom_put( "EXPSI" , zw3d )564 ENDIF565 IF( iom_use( "XNUM" ) ) THEN566 zw3d(:,:,:) = znum3d(:,:,:) * tmask(:,:,:) ! Number of particles on aggregats567 CALL iom_put( "XNUM" , zw3d )568 ENDIF569 IF( iom_use( "WSC" ) ) THEN570 zw3d(:,:,:) = wsbio3(:,:,:) * tmask(:,:,:) ! Sinking speed of carbon particles571 CALL iom_put( "WSC" , zw3d )572 ENDIF573 IF( iom_use( "WSN" ) ) THEN574 zw3d(:,:,:) = wsbio4(:,:,:) * tmask(:,:,:) ! Sinking speed of particles number575 CALL iom_put( "WSN" , zw3d )576 ENDIF577 !578 CALL wrk_dealloc( jpi, jpj, zw2d )579 CALL wrk_dealloc( jpi, jpj, jpk, zw3d )580 ELSE581 IF( ln_diatrc ) THEN582 zfact = 1.e3 * rfact2r583 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1)584 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1)585 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1)586 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik100) * zfact * tmask(:,:,1)587 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1)588 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zfact * tmask(:,:,:)589 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zfact * tmask(:,:,:)590 trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:) * zfact * tmask(:,:,:)591 trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:) * zfact * tmask(:,:,:)592 trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d (:,:,:) * tmask(:,:,:)593 trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3 (:,:,:) * tmask(:,:,:)594 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:)595 ENDIF596 ENDIF597 598 !599 IF(ln_ctl) THEN ! print mean trends (used for debugging)600 WRITE(charout, FMT="('sink')")601 CALL prt_ctl_trc_info(charout)602 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)603 ENDIF604 !605 CALL wrk_dealloc( jpi, jpj, jpk, znum3d )606 !607 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink')608 !609 END SUBROUTINE p4z_sink610 611 612 SUBROUTINE p4z_sink_init613 !!----------------------------------------------------------------------614 !! *** ROUTINE p4z_sink_init ***615 !!616 !! ** Purpose : Initialization of sinking parameters617 !! Kriest parameterization only618 !!619 !! ** Method : Read the nampiskrs namelist and check the parameters620 !! called at the first timestep621 !!622 !! ** input : Namelist nampiskrs623 !!----------------------------------------------------------------------624 INTEGER :: jk, jn, kiter625 INTEGER :: ios ! Local integer output status for namelist read626 REAL(wp) :: znum, zdiv627 REAL(wp) :: zws, zwr, zwl,wmax, znummax628 REAL(wp) :: zmin, zmax, zl, zr, xacc629 !630 NAMELIST/nampiskrs/ xkr_sfact, xkr_stick , &631 & xkr_nnano, xkr_ndiat, xkr_nmicro, xkr_nmeso, xkr_naggr632 !!----------------------------------------------------------------------633 !634 IF( nn_timing == 1 ) CALL timing_start('p4z_sink_init')635 !636 637 REWIND( numnatp_ref ) ! Namelist nampiskrs in reference namelist : Pisces sinking Kriest638 READ ( numnatp_ref, nampiskrs, IOSTAT = ios, ERR = 901)639 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in reference namelist', lwp )640 641 REWIND( numnatp_cfg ) ! Namelist nampiskrs in configuration namelist : Pisces sinking Kriest642 READ ( numnatp_cfg, nampiskrs, IOSTAT = ios, ERR = 902 )643 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in configuration namelist', lwp )644 IF(lwm) WRITE ( numonp, nampiskrs )645 646 IF(lwp) THEN647 WRITE(numout,*)648 WRITE(numout,*) ' Namelist : nampiskrs'649 WRITE(numout,*) ' Sinking factor xkr_sfact = ', xkr_sfact650 WRITE(numout,*) ' Stickiness xkr_stick = ', xkr_stick651 WRITE(numout,*) ' Nbr of cell in nano size class xkr_nnano = ', xkr_nnano652 WRITE(numout,*) ' Nbr of cell in diatoms size class xkr_ndiat = ', xkr_ndiat653 WRITE(numout,*) ' Nbr of cell in microzoo size class xkr_nmicro = ', xkr_nmicro654 WRITE(numout,*) ' Nbr of cell in mesozoo size class xkr_nmeso = ', xkr_nmeso655 WRITE(numout,*) ' Nbr of cell in aggregates size class xkr_naggr = ', xkr_naggr656 ENDIF657 658 659 ! max and min vertical particle speed660 xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta661 xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta662 IF (lwp) WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max663 664 !665 ! effect of the sizes of the different living pools on particle numbers666 ! nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337667 ! diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718668 ! mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147669 ! aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877670 ! doc aggregates = 1um671 ! ----------------------------------------------------------672 673 xkr_dnano = 1. / ( xkr_massp * xkr_nnano )674 xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat )675 xkr_dmicro = 1. / ( xkr_massp * xkr_nmicro )676 xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso )677 xkr_daggr = 1. / ( xkr_massp * xkr_naggr )678 679 !!---------------------------------------------------------------------680 !! 'key_kriest' ???681 !!---------------------------------------------------------------------682 ! COMPUTATION OF THE VERTICAL PROFILE OF MAXIMUM SINKING SPEED683 ! Search of the maximum number of particles in aggregates for each k-level.684 ! Bissection Method685 !--------------------------------------------------------------------686 IF (lwp) THEN687 WRITE(numout,*)688 WRITE(numout,*)' kriest : Compute maximum number of particles in aggregates'689 ENDIF690 691 xacc = 0.001_wp692 kiter = 50693 zmin = 1.10_wp694 zmax = xkr_mass_max / xkr_mass_min695 xkr_frac = zmax696 697 DO jk = 1,jpk698 zl = zmin699 zr = zmax700 wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2701 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl702 znum = zl - 1.703 zwl = xkr_wsbio_min * xkr_zeta / zdiv &704 & - ( xkr_wsbio_max * xkr_eta * znum * &705 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) &706 & - wmax707 708 zdiv = xkr_zeta + xkr_eta - xkr_eta * zr709 znum = zr - 1.710 zwr = xkr_wsbio_min * xkr_zeta / zdiv &711 & - ( xkr_wsbio_max * xkr_eta * znum * &712 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) &713 & - wmax714 iflag: DO jn = 1, kiter715 IF ( zwl == 0._wp ) THEN ; znummax = zl716 ELSEIF( zwr == 0._wp ) THEN ; znummax = zr717 ELSE718 znummax = ( zr + zl ) / 2.719 zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax720 znum = znummax - 1.721 zws = xkr_wsbio_min * xkr_zeta / zdiv &722 & - ( xkr_wsbio_max * xkr_eta * znum * &723 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) &724 & - wmax725 IF( zws * zwl < 0. ) THEN ; zr = znummax726 ELSE ; zl = znummax727 ENDIF728 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl729 znum = zl - 1.730 zwl = xkr_wsbio_min * xkr_zeta / zdiv &731 & - ( xkr_wsbio_max * xkr_eta * znum * &732 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) &733 & - wmax734 735 zdiv = xkr_zeta + xkr_eta - xkr_eta * zr736 znum = zr - 1.737 zwr = xkr_wsbio_min * xkr_zeta / zdiv &738 & - ( xkr_wsbio_max * xkr_eta * znum * &739 & xkr_frac**( -xkr_zeta / znum ) / zdiv ) &740 & - wmax741 !742 IF ( ABS ( zws ) <= xacc ) EXIT iflag743 !744 ENDIF745 !746 END DO iflag747 748 xnumm(jk) = znummax749 IF (lwp) WRITE(numout,*) ' jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk)750 !751 END DO752 !753 ik100 = 10 ! last level where depth less than 100 m754 DO jk = jpkm1, 1, -1755 IF( gdept_1d(jk) > 100. ) iksed = jk - 1756 END DO757 IF (lwp) WRITE(numout,*)758 IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ', ik100 + 1759 IF (lwp) WRITE(numout,*)760 !761 t_oce_co2_exp = 0._wp762 !763 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink_init')764 !765 END SUBROUTINE p4z_sink_init766 767 #endif768 284 769 285 SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra, kiter ) … … 794 310 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) 795 311 796 zstep = rfact2 / FLOAT( kiter) / 2.312 zstep = rfact2 / REAL( kiter, wp ) / 2. 797 313 798 314 ztraz(:,:,:) = 0.e0 … … 804 320 END DO 805 321 zwsink2(:,:,1) = 0.e0 806 IF( lk_degrad ) THEN807 zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:)808 ENDIF809 322 810 323 … … 887 400 !! *** ROUTINE p4z_sink_alloc *** 888 401 !!---------------------------------------------------------------------- 889 ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) , & 890 & sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk) , & 891 & sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk) , & 892 #if defined key_kriest 893 & xnumm(jpk) , & 894 #else 895 & sinkfer2(jpi,jpj,jpk) , & 896 #endif 897 & sinkfer(jpi,jpj,jpk) , STAT=p4z_sink_alloc ) 402 INTEGER :: ierr(3) 403 404 ierr(:) = 0 405 ! 406 ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk) , & 407 & sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk) , & 408 & sinkfer2(jpi,jpj,jpk) , & 409 & sinkfer(jpi,jpj,jpk) , STAT=ierr(1) ) 898 410 ! 411 IF( ln_ligand ) ALLOCATE( sinkfep(jpi,jpj,jpk) , STAT=ierr(2) ) 412 413 IF( ln_p5z ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk) , & 414 & sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk) , STAT=ierr(3) ) 415 ! 416 p4z_sink_alloc = MAXVAL( ierr ) 899 417 IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 900 418 ! 901 419 END FUNCTION p4z_sink_alloc 902 420 903 #else904 !!======================================================================905 !! Dummy module : No PISCES bio-model906 !!======================================================================907 CONTAINS908 SUBROUTINE p4z_sink ! Empty routine909 END SUBROUTINE p4z_sink910 #endif911 912 421 !!====================================================================== 913 422 END MODULE p4zsink -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r6421 r7403 6 6 !! History : 1.0 ! 2004-03 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !!----------------------------------------------------------------------9 #if defined key_pisces10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES bio-model12 8 !!---------------------------------------------------------------------- 13 9 !! p4zsms : Time loop of passive tracers sms … … 69 65 INTEGER :: ji, jj, jk, jnt, jn, jl 70 66 REAL(wp) :: ztra 71 #if defined key_kriest72 REAL(wp) :: zcoef1, zcoef273 #endif74 67 CHARACTER (len=25) :: charout 75 68 !!--------------------------------------------------------------------- … … 83 76 CALL p4z_che ! initialize the chemical constants 84 77 ! 85 IF( .NOT. ln_rsttr ) THEN ; CALL p4z_ph_ini! set PH at kt=nit00078 IF( .NOT. ln_rsttr ) THEN ; CALL ahini_for_at(hi) ! set PH at kt=nit000 86 79 ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields 87 80 ENDIF … … 91 84 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 92 85 ! 93 ! ! set time step size (Euler/Leapfrog) 94 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc ! at nittrc000 95 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 96 ENDIF 86 rfact = r2dttrc 97 87 ! 98 88 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 99 89 rfactr = 1. / rfact 100 rfact2 = rfact / FLOAT( nrdttrc)90 rfact2 = rfact / REAL( nrdttrc, wp ) 101 91 rfact2r = 1. / rfact2 102 92 xstep = rfact2 / rday ! Time step duration for biology … … 165 155 END DO 166 156 167 #if defined key_kriest168 !169 zcoef1 = 1.e0 / xkr_massp170 zcoef2 = 1.e0 / xkr_massp / 1.1171 DO jk = 1,jpkm1172 trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )173 trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 )174 END DO175 !176 #endif177 !178 157 ! 179 158 IF( l_trdtrc ) THEN … … 212 191 !! ** input : file 'namelist.trc.s' containing the following 213 192 !! namelist: natext, natbio, natsms 214 !! natkriest ("key_kriest") 215 !!---------------------------------------------------------------------- 216 NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max 217 #if defined key_kriest 218 NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max 219 #endif 193 !!---------------------------------------------------------------------- 194 NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale, & 195 & niter1max, niter2max, wfep, ldocp, ldocz, lthet, & 196 & no3rat3, po4rat3 197 220 198 NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp 221 199 NAMELIST/nampismass/ ln_check_mass … … 234 212 IF(lwp) THEN ! control print 235 213 WRITE(numout,*) ' Namelist : nampisbio' 236 WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc 237 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio 238 WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort 239 WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3 240 WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2 214 WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc 215 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio 216 WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort 217 IF( ln_p5z ) THEN 218 WRITE(numout,*) ' N/C in zooplankton no3rat3 =', no3rat3 219 WRITE(numout,*) ' P/C in zooplankton po4rat3 =', po4rat3 220 ENDIF 221 WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3 222 WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2 223 WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max =', wsbio2max 224 WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale 241 225 WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max 242 226 WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max 243 ENDIF 244 245 #if defined key_kriest 246 247 ! ! nampiskrp : kriest parameters 248 ! ! ----------------------------- 249 REWIND( numnatp_ref ) ! Namelist nampiskrp in reference namelist : Pisces Kriest 250 READ ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903) 251 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp ) 252 253 REWIND( numnatp_cfg ) ! Namelist nampiskrp in configuration namelist : Pisces Kriest 254 READ ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 ) 255 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp ) 256 IF(lwm) WRITE ( numonp, nampiskrp ) 257 258 IF(lwp) THEN 259 WRITE(numout,*) 260 WRITE(numout,*) ' Namelist : nampiskrp' 261 WRITE(numout,*) ' Sinking exponent xkr_eta = ', xkr_eta 262 WRITE(numout,*) ' N content exponent xkr_zeta = ', xkr_zeta 263 WRITE(numout,*) ' N content factor xkr_ncontent = ', xkr_ncontent 264 WRITE(numout,*) ' Minimum mass for Aggregates xkr_mass_min = ', xkr_mass_min 265 WRITE(numout,*) ' Maximum mass for Aggregates xkr_mass_max = ', xkr_mass_max 266 WRITE(numout,*) 267 ENDIF 268 269 270 ! Computation of some variables 271 xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta 272 273 #endif 227 IF( ln_ligand ) THEN 228 WRITE(numout,*) ' FeP sinking speed wfep =', wfep 229 IF( ln_p4z ) THEN 230 WRITE(numout,*) ' Phyto ligand production per unit doc ldocp =', ldocp 231 WRITE(numout,*) ' Zoo ligand production per unit doc ldocz =', ldocz 232 WRITE(numout,*) ' Proportional loss of ligands due to Fe uptake lthet =', lthet 233 ENDIF 234 ENDIF 235 ENDIF 236 274 237 275 238 REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping … … 308 271 END SUBROUTINE p4z_sms_init 309 272 310 SUBROUTINE p4z_ph_ini311 !!---------------------------------------------------------------------312 !! *** ROUTINE p4z_ini_ph ***313 !!314 !! ** Purpose : Initialization of chemical variables of the carbon cycle315 !!---------------------------------------------------------------------316 INTEGER :: ji, jj, jk317 REAL(wp) :: zcaralk, zbicarb, zco3318 REAL(wp) :: ztmas, ztmas1319 !!---------------------------------------------------------------------320 321 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???)322 ! --------------------------------------------------------323 DO jk = 1, jpk324 DO jj = 1, jpj325 DO ji = 1, jpi326 ztmas = tmask(ji,jj,jk)327 ztmas1 = 1. - tmask(ji,jj,jk)328 zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )329 zco3 = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1330 zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )331 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1332 END DO333 END DO334 END DO335 !336 END SUBROUTINE p4z_ph_ini337 338 273 SUBROUTINE p4z_rst( kt, cdrw ) 339 274 !!--------------------------------------------------------------------- … … 349 284 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 350 285 ! 351 INTEGER :: ji, jj, jk352 REAL(wp) :: zcaralk, zbicarb, zco3353 REAL(wp) :: ztmas, ztmas1354 286 !!--------------------------------------------------------------------- 355 287 … … 363 295 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 364 296 ELSE 365 ! hi(:,:,:) = 1.e-9 366 CALL p4z_ph_ini 297 CALL ahini_for_at(hi) 367 298 ENDIF 368 299 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 379 310 ENDIF 380 311 ! 312 IF( ln_p5z ) THEN 313 IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 314 CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:) ) 315 CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:) ) 316 CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:) ) 317 ELSE 318 sizep(:,:,:) = 1. 319 sizen(:,:,:) = 1. 320 sized(:,:,:) = 1. 321 ENDIF 322 ENDIF 323 ! 381 324 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 382 325 IF( kt == nitrst ) THEN … … 389 332 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 390 333 CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 334 IF( ln_p5z ) THEN 335 CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) ) 336 CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) ) 337 CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) 338 ENDIF 391 339 ENDIF 392 340 ! … … 475 423 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 476 424 CHARACTER(LEN=100) :: cltxt 477 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol478 425 INTEGER :: jk 426 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork 479 427 !!---------------------------------------------------------------------- 480 428 … … 496 444 ENDIF 497 445 446 CALL wrk_alloc( jpi, jpj, jpk, zwork ) 498 447 ! 499 448 IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 500 449 ! Compute the budget of NO3, ALK, Si, Fer 501 no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 502 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 503 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 504 & + trn(:,:,:,jppoc) & 505 #if ! defined key_kriest 506 & + trn(:,:,:,jpgoc) & 507 #endif 508 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 509 ! 510 no3budget = no3budget / areatot 511 CALL iom_put( "pno3tot", no3budget ) 450 IF( ln_p4z ) THEN 451 zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 452 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 453 & + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) & 454 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 455 ELSE 456 zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) & 457 & + trn(:,:,:,jpndi) + trn(:,:,:,jpnpi) & 458 & + trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) & 459 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 460 ENDIF 461 ! 462 no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 463 no3budget = no3budget / areatot 464 CALL iom_put( "pno3tot", no3budget ) 512 465 ENDIF 513 466 ! 514 467 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 515 po4budget = glob_sum( ( trn(:,:,:,jppo4) & 516 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 517 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 518 & + trn(:,:,:,jppoc) & 519 #if ! defined key_kriest 520 & + trn(:,:,:,jpgoc) & 521 #endif 522 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 523 po4budget = po4budget / areatot 524 CALL iom_put( "ppo4tot", po4budget ) 468 IF( ln_p4z ) THEN 469 zwork(:,:,:) = trn(:,:,:,jppo4) & 470 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 471 & + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) & 472 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 473 ELSE 474 zwork(:,:,:) = trn(:,:,:,jppo4) + trn(:,:,:,jppph) & 475 & + trn(:,:,:,jppdi) + trn(:,:,:,jpppi) & 476 & + trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) & 477 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 478 ENDIF 479 ! 480 po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 481 po4budget = po4budget / areatot 482 CALL iom_put( "ppo4tot", po4budget ) 525 483 ENDIF 526 484 ! 527 485 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 528 silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &529 & + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )530 !486 zwork(:,:,:) = trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 487 ! 488 silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 531 489 silbudget = silbudget / areatot 532 490 CALL iom_put( "psiltot", silbudget ) … … 534 492 ! 535 493 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 536 alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 & 537 & + trn(:,:,:,jptal) & 538 & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) ) 539 ! 494 zwork(:,:,:) = trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2. 495 ! 496 alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) ! 540 497 alkbudget = alkbudget / areatot 541 498 CALL iom_put( "palktot", alkbudget ) … … 543 500 ! 544 501 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 545 ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) & 546 & + trn(:,:,:,jpdfe) & 547 #if ! defined key_kriest 548 & + trn(:,:,:,jpbfe) & 549 #endif 550 & + trn(:,:,:,jpsfe) & 551 & + trn(:,:,:,jpzoo) * ferat3 & 552 & + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) ) 553 ! 502 zwork(:,:,:) = trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) & 503 & + trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe) & 504 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3 505 IF( ln_ligand) zwork(:,:,:) = zwork(:,:,:) + trn(:,:,:,jpfep) 506 ! 507 ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 554 508 ferbudget = ferbudget / areatot 555 509 CALL iom_put( "pfertot", ferbudget ) 556 510 ENDIF 557 511 ! 558 512 CALL wrk_dealloc( jpi, jpj, jpk, zwork ) 513 ! 559 514 ! Global budget of N SMS : denitrification in the water column and in the sediment 560 515 ! nitrogen fixation by the diazotrophs … … 600 555 END SUBROUTINE p4z_chk_mass 601 556 602 #else603 !!======================================================================604 !! Dummy module : No PISCES bio-model605 !!======================================================================606 CONTAINS607 SUBROUTINE p4z_sms( kt ) ! Empty routine608 INTEGER, INTENT( in ) :: kt609 WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt610 END SUBROUTINE p4z_sms611 #endif612 613 557 !!====================================================================== 614 558 END MODULE p4zsms -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
r5215 r7403 24 24 #endif 25 25 26 #if defined key_kriest27 INTEGER, PARAMETER :: jpdta = 1128 #else29 26 INTEGER, PARAMETER :: jpdta = 12 30 #endif31 27 32 28 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
r5215 r7403 40 40 41 41 USE p4zsink , ONLY : sinking => sinking !: sinking flux for POC 42 #if ! defined key_kriest43 42 USE p4zsink , ONLY : sinking2 => sinking2 !: sinking flux for GOC 44 #endif45 43 USE p4zsink , ONLY : sinkcal => sinkcal !: sinking flux for calcite 46 44 USE p4zsink , ONLY : sinksil => sinksil !: sinking flux for opal ( dsi ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
r5215 r7403 55 55 56 56 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdta 57 #if ! defined key_kriest58 57 REAL(wp), DIMENSION(:) , ALLOCATABLE :: zdtap, zdtag 59 #endif60 58 61 59 … … 97 95 ENDIF 98 96 99 100 #if ! defined key_kriest101 97 ! Initialization of temporaries arrays 102 98 ALLOCATE( zdtap(jpoce) ) ; zdtap(:) = 0. 103 99 ALLOCATE( zdtag(jpoce) ) ; zdtag(:) = 0. 104 #endif105 106 100 107 101 IF( MOD( kt - 1, nfreq ) == 0 ) THEN … … 122 116 trc_data(ji,jj,5) = trn (ji,jj,ikt,jpoxy) 123 117 trc_data(ji,jj,6) = trn (ji,jj,ikt,jpsil) 124 # if ! defined key_kriest125 118 trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 126 119 trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) … … 129 122 trc_data(ji,jj,11) = tsn (ji,jj,ikt,jp_tem) 130 123 trc_data(ji,jj,12) = tsn (ji,jj,ikt,jp_sal) 131 # else132 trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)133 trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)134 trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt)135 trc_data(ji,jj,10) = tsn (ji,jj,ikt,jp_tem)136 trc_data(ji,jj,11) = tsn (ji,jj,ikt,jp_sal)137 # endif138 124 ENDIF 139 125 ENDDO … … 147 133 CALL iom_get( numbio, jpdom_data, 'O2BOT' , trc_data(:,:,5 ) ) 148 134 CALL iom_get( numbio, jpdom_data, 'SIBOT' , trc_data(:,:,6 ) ) 149 # if ! defined key_kriest150 135 CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 151 136 CALL iom_get( numbio, jpdom_data, 'POCFLXBOT' , trc_data(:,:,8 ) ) … … 154 139 CALL iom_get( numoce, jpdom_data, 'TBOT' , trc_data(:,:,11) ) 155 140 CALL iom_get( numoce, jpdom_data, 'SBOT' , trc_data(:,:,12) ) 156 # else157 CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) )158 CALL iom_get( numbio, jpdom_data, 'POCFLXBOT' , trc_data(:,:,8 ) )159 CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,9 ) )160 CALL iom_get( numoce, jpdom_data, 'TBOT' , trc_data(:,:,10) )161 CALL iom_get( numoce, jpdom_data, 'SBOT' , trc_data(:,:,11) )162 # endif163 141 #endif 164 142 … … 186 164 ! Solid components : 187 165 !----------------------- 188 #if ! defined key_kriest189 166 ! Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 190 167 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) … … 200 177 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 201 178 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 202 #else203 ! Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1204 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) )205 rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4206 ! Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1207 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jspoc), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )208 rainrm_dta(1:jpoce,jspoc) = rainrm_dta(1:jpoce,jspoc) * 1e-4209 ! Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1210 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce) )211 rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4212 ! vector temperature [°C] and salinity213 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) )214 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )215 216 #endif217 179 218 180 ! Clay rain rate in [mol/(cm**2.s)] … … 252 214 253 215 DEALLOCATE( zdta ) 254 #if ! defined key_kriest255 216 DEALLOCATE( zdtap ) ; DEALLOCATE( zdtag ) 256 #endif257 217 258 218 IF( kt == nitsedend ) THEN -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
r5215 r7403 15 15 PUBLIC sed_model ! called by step.F90 16 16 17 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag18 19 !! $Id$20 17 CONTAINS 21 18 … … 47 44 !! MODULE sedmodel : Dummy module 48 45 !!====================================================================== 49 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag50 !! $Id$51 46 CONTAINS 52 47 SUBROUTINE sed_model( kt ) ! Empty routine -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
r5385 r7403 13 13 IMPLICIT NONE 14 14 15 #if defined key_pisces_reduced 16 !!--------------------------------------------------------------------- 17 !! 'key_pisces_reduced' : LOBSTER bio-model 18 !!--------------------------------------------------------------------- 19 LOGICAL, PUBLIC, PARAMETER :: lk_pisces = .TRUE. !: PISCES flag 20 LOGICAL, PUBLIC, PARAMETER :: lk_p4z = .FALSE. !: p4z flag 21 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 6 !: number of passive tracers 22 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 19 !: additional 2d output 23 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 3 !: additional 3d output 24 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 17 !: number of sms trends for PISCES 15 ! productive layer depth 16 INTEGER, PUBLIC :: jpkb !: first vertical layers where biology is active 17 INTEGER, PUBLIC :: jpkbm1 !: first vertical layers where biology is active 25 18 26 19 ! assign an index in trc arrays for each LOBSTER prognostic variables 27 INTEGER, PUBLIC, PARAMETER :: jpdet = 1 !: detritus [mmoleN/m3] 28 INTEGER, PUBLIC, PARAMETER :: jpzoo = 2 !: zooplancton concentration [mmoleN/m3] 29 INTEGER, PUBLIC, PARAMETER :: jpphy = 3 !: phytoplancton concentration [mmoleN/m3] 30 INTEGER, PUBLIC, PARAMETER :: jpno3 = 4 !: nitrate concentration [mmoleN/m3] 31 INTEGER, PUBLIC, PARAMETER :: jpnh4 = 5 !: ammonium concentration [mmoleN/m3] 32 INTEGER, PUBLIC, PARAMETER :: jpdom = 6 !: dissolved organic matter [mmoleN/m3] 20 INTEGER, PUBLIC :: jpdet !: detritus 21 INTEGER, PUBLIC :: jpdom !: dissolved organic matter 22 INTEGER, PUBLIC :: jpdic !: dissolved inoganic carbon concentration 23 INTEGER, PUBLIC :: jptal !: total alkalinity 24 INTEGER, PUBLIC :: jpoxy !: oxygen carbon concentration 25 INTEGER, PUBLIC :: jpcal !: calcite concentration 26 INTEGER, PUBLIC :: jppo4 !: phosphate concentration 27 INTEGER, PUBLIC :: jppoc !: small particulate organic phosphate concentration 28 INTEGER, PUBLIC :: jpsil !: silicate concentration 29 INTEGER, PUBLIC :: jpphy !: phytoplancton concentration 30 INTEGER, PUBLIC :: jpzoo !: zooplancton concentration 31 INTEGER, PUBLIC :: jpdoc !: dissolved organic carbon concentration 32 INTEGER, PUBLIC :: jpdia !: Diatoms Concentration 33 INTEGER, PUBLIC :: jpmes !: Mesozooplankton Concentration 34 INTEGER, PUBLIC :: jpdsi !: Diatoms Silicate Concentration 35 INTEGER, PUBLIC :: jpfer !: Iron Concentration 36 INTEGER, PUBLIC :: jpbfe !: Big iron particles Concentration 37 INTEGER, PUBLIC :: jpgoc !: big particulate organic phosphate concentration 38 INTEGER, PUBLIC :: jpsfe !: Small iron particles Concentration 39 INTEGER, PUBLIC :: jpdfe !: Diatoms iron Concentration 40 INTEGER, PUBLIC :: jpgsi !: (big) Silicate Concentration 41 INTEGER, PUBLIC :: jpnfe !: Nano iron Concentration 42 INTEGER, PUBLIC :: jpnch !: Nano Chlorophyll Concentration 43 INTEGER, PUBLIC :: jpdch !: Diatoms Chlorophyll Concentration 44 INTEGER, PUBLIC :: jpno3 !: Nitrates Concentration 45 INTEGER, PUBLIC :: jpnh4 !: Ammonium Concentration 46 INTEGER, PUBLIC :: jpdon !: dissolved organic nitrogen concentration 47 INTEGER, PUBLIC :: jpdop !: dissolved organic phosphorus concentration 48 INTEGER, PUBLIC :: jppon !: small particulate organic nitrogen concentration 49 INTEGER, PUBLIC :: jppop !: small particulate organic phosphorus concentration 50 INTEGER, PUBLIC :: jpnph !: small particulate organic phosphorus concentration 51 INTEGER, PUBLIC :: jppph !: small particulate organic phosphorus concentration 52 INTEGER, PUBLIC :: jpndi !: small particulate organic phosphorus concentration 53 INTEGER, PUBLIC :: jppdi !: small particulate organic phosphorus concentration 54 INTEGER, PUBLIC :: jppic !: small particulate organic phosphorus concentration 55 INTEGER, PUBLIC :: jpnpi !: small particulate organic phosphorus concentration 56 INTEGER, PUBLIC :: jpppi !: small particulate organic phosphorus concentration 57 INTEGER, PUBLIC :: jppfe !: small particulate organic phosphorus concentration 58 INTEGER, PUBLIC :: jppch !: small particulate organic phosphorus concentration 59 INTEGER, PUBLIC :: jpgon !: Big nitrogen particles Concentration 60 INTEGER, PUBLIC :: jpgop !: Big phosphorus particles Concentration 61 INTEGER, PUBLIC :: jplgw !: Weak Ligands 62 INTEGER, PUBLIC :: jpfep !: Fe nanoparticle 33 63 34 ! productive layer depth35 INTEGER, PUBLIC, PARAMETER :: jpkb = 12 !: first vertical layers where biology is active36 INTEGER, PUBLIC, PARAMETER :: jpkbm1 = jpkb - 1 !: first vertical layers where biology is active37 38 #elif defined key_pisces && defined key_kriest39 !!---------------------------------------------------------------------40 !! 'key_pisces' & 'key_kriest' PISCES bio-model + ???41 !!---------------------------------------------------------------------42 LOGICAL, PUBLIC, PARAMETER :: lk_pisces = .TRUE. !: PISCES flag43 LOGICAL, PUBLIC, PARAMETER :: lk_p4z = .TRUE. !: p4z flag44 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .TRUE. !: Kriest flag45 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 23 !: number of passive tracers46 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output47 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 18 !: additional 3d output48 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES49 50 ! assign an index in trc arrays for each LOBSTER prognostic variables51 ! WARNING: be carefull about the order when reading the restart52 ! !!gm this warning should be obsolet with IOM53 INTEGER, PUBLIC, PARAMETER :: jpdic = 1 !: dissolved inoganic carbon concentration54 INTEGER, PUBLIC, PARAMETER :: jptal = 2 !: total alkalinity55 INTEGER, PUBLIC, PARAMETER :: jpoxy = 3 !: oxygen carbon concentration56 INTEGER, PUBLIC, PARAMETER :: jpcal = 4 !: calcite concentration57 INTEGER, PUBLIC, PARAMETER :: jppo4 = 5 !: phosphate concentration58 INTEGER, PUBLIC, PARAMETER :: jppoc = 6 !: small particulate organic phosphate concentration59 INTEGER, PUBLIC, PARAMETER :: jpsil = 7 !: silicate concentration60 INTEGER, PUBLIC, PARAMETER :: jpphy = 8 !: phytoplancton concentration61 INTEGER, PUBLIC, PARAMETER :: jpzoo = 9 !: zooplancton concentration62 INTEGER, PUBLIC, PARAMETER :: jpdoc = 10 !: dissolved organic carbon concentration63 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration64 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration65 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration66 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration67 INTEGER, PUBLIC, PARAMETER :: jpnum = 15 !: Big iron particles Concentration68 INTEGER, PUBLIC, PARAMETER :: jpsfe = 16 !: number of particulate organic phosphate concentration69 INTEGER, PUBLIC, PARAMETER :: jpdfe = 17 !: Diatoms iron Concentration70 INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: (big) Silicate Concentration71 INTEGER, PUBLIC, PARAMETER :: jpnfe = 19 !: Nano iron Concentration72 INTEGER, PUBLIC, PARAMETER :: jpnch = 20 !: Nano Chlorophyll Concentration73 INTEGER, PUBLIC, PARAMETER :: jpdch = 21 !: Diatoms Chlorophyll Concentration74 INTEGER, PUBLIC, PARAMETER :: jpno3 = 22 !: Nitrates Concentration75 INTEGER, PUBLIC, PARAMETER :: jpnh4 = 23 !: Ammonium Concentration76 77 #elif defined key_pisces78 !!---------------------------------------------------------------------79 !! 'key_pisces' : standard PISCES bio-model80 !!---------------------------------------------------------------------81 LOGICAL, PUBLIC, PARAMETER :: lk_pisces = .TRUE. !: PISCES flag82 LOGICAL, PUBLIC, PARAMETER :: lk_p4z = .TRUE. !: p4z flag83 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .FALSE. !: Kriest flag84 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 24 !: number of PISCES passive tracers85 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output86 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 11 !: additional 3d output87 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES88 89 ! assign an index in trc arrays for each LOBSTER prognostic variables90 ! WARNING: be carefull about the order when reading the restart91 ! !!gm this warning should be obsolet with IOM92 INTEGER, PUBLIC, PARAMETER :: jpdic = 1 !: dissolved inoganic carbon concentration93 INTEGER, PUBLIC, PARAMETER :: jptal = 2 !: total alkalinity94 INTEGER, PUBLIC, PARAMETER :: jpoxy = 3 !: oxygen carbon concentration95 INTEGER, PUBLIC, PARAMETER :: jpcal = 4 !: calcite concentration96 INTEGER, PUBLIC, PARAMETER :: jppo4 = 5 !: phosphate concentration97 INTEGER, PUBLIC, PARAMETER :: jppoc = 6 !: small particulate organic phosphate concentration98 INTEGER, PUBLIC, PARAMETER :: jpsil = 7 !: silicate concentration99 INTEGER, PUBLIC, PARAMETER :: jpphy = 8 !: phytoplancton concentration100 INTEGER, PUBLIC, PARAMETER :: jpzoo = 9 !: zooplancton concentration101 INTEGER, PUBLIC, PARAMETER :: jpdoc = 10 !: dissolved organic carbon concentration102 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration103 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration104 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration105 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration106 INTEGER, PUBLIC, PARAMETER :: jpbfe = 15 !: Big iron particles Concentration107 INTEGER, PUBLIC, PARAMETER :: jpgoc = 16 !: big particulate organic phosphate concentration108 INTEGER, PUBLIC, PARAMETER :: jpsfe = 17 !: Small iron particles Concentration109 INTEGER, PUBLIC, PARAMETER :: jpdfe = 18 !: Diatoms iron Concentration110 INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: (big) Silicate Concentration111 INTEGER, PUBLIC, PARAMETER :: jpnfe = 20 !: Nano iron Concentration112 INTEGER, PUBLIC, PARAMETER :: jpnch = 21 !: Nano Chlorophyll Concentration113 INTEGER, PUBLIC, PARAMETER :: jpdch = 22 !: Diatoms Chlorophyll Concentration114 INTEGER, PUBLIC, PARAMETER :: jpno3 = 23 !: Nitrates Concentration115 INTEGER, PUBLIC, PARAMETER :: jpnh4 = 24 !: Ammonium Concentration116 117 #else118 64 !!--------------------------------------------------------------------- 119 65 !! Default No CFC geochemical model 120 !!---------------------------------------------------------------------121 LOGICAL, PUBLIC, PARAMETER :: lk_pisces = .FALSE. !: PISCES flag122 LOGICAL, PUBLIC, PARAMETER :: lk_p4z = .FALSE. !: p4z flag123 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 0 !: No CFC tracers124 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 0 !: No CFC additional 2d output arrays125 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 0 !: No CFC additional 3d output arrays126 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 0 !: number of sms trends for PISCES127 #endif128 129 66 ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 130 INTEGER, PUBLIC, PARAMETER :: jp_pcs0 = 1 !: First index of PISCES tracers 131 INTEGER, PUBLIC, PARAMETER :: jp_pcs1 = jp_pisces !: Last index of PISCES tracers 132 INTEGER, PUBLIC, PARAMETER :: jp_pcs0_2d = 1 !: First index of 2D diag 133 INTEGER, PUBLIC, PARAMETER :: jp_pcs1_2d = jp_pisces_2d !: Last index of 2D diag 134 INTEGER, PUBLIC, PARAMETER :: jp_pcs0_3d = 1 !: First index of 3D diag 135 INTEGER, PUBLIC, PARAMETER :: jp_pcs1_3d = jp_pisces_3d !: Last index of 3d diag 136 INTEGER, PUBLIC, PARAMETER :: jp_pcs0_trd = 1 !: First index of bio diag 137 INTEGER, PUBLIC, PARAMETER :: jp_pcs1_trd = jp_pisces_trd !: Last index of bio diag 138 67 INTEGER, PUBLIC :: jp_pcs0 !: First index of PISCES tracers 68 INTEGER, PUBLIC :: jp_pcs1 !: Last index of PISCES tracers 139 69 140 70 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r6291 r7403 6 6 !! History : 1.0 ! 2000-02 (O. Aumont) original code 7 7 !! 3.2 ! 2009-04 (C. Ethe & NEMO team) style 8 !!----------------------------------------------------------------------9 #if defined key_pisces || defined key_pisces_reduced10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES model12 8 !!---------------------------------------------------------------------- 13 9 USE par_oce … … 21 17 INTEGER :: numonp = -1 !! Logical unit for namelist pisces output 22 18 23 !!* Biological fluxes for light : variables shared by pisces & lobster24 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer25 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth26 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot !: par (photosynthetic available radiation)27 !28 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: LOBSTER : zooplakton closure29 19 ! !: PISCES : silicon dependant half saturation 30 20 31 #if defined key_pisces 21 !!* Model used 22 LOGICAL :: ln_p2z !: Flag to use LOBSTER model 23 LOGICAL :: ln_p4z !: Flag to use PISCES model 24 LOGICAL :: ln_p5z !: Flag to use PISCES quota model 25 LOGICAL :: ln_ligand !: Flag to enable organic ligands 26 32 27 !!* Time variables 33 28 INTEGER :: nrdttrc !: ??? … … 49 44 REAL(wp) :: o2nit !: ??? 50 45 REAL(wp) :: wsbio, wsbio2 !: ??? 46 REAL(wp) :: wsbio2max !: ??? 47 REAL(wp) :: wsbio2scale !: ??? 51 48 REAL(wp) :: xkmort !: ??? 52 49 REAL(wp) :: ferat3 !: ??? 50 REAL(wp) :: wfep !: ??? 51 REAL(wp) :: ldocp !: ??? 52 REAL(wp) :: ldocz !: ??? 53 REAL(wp) :: lthet !: ??? 54 REAL(wp) :: no3rat3 !: ??? 55 REAL(wp) :: po4rat3 !: ??? 56 53 57 54 58 !!* diagnostic parameters … … 66 70 LOGICAL :: ln_check_mass !: Flag to check mass conservation 67 71 72 !!* Biological fluxes for light : variables shared by pisces & lobster 73 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot !: par (photosynthetic available radiation) 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: epico !: PAR for pico 79 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 80 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup_01 !: Absolute euphotic layer depth 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: LOBSTER : zooplakton closure 82 68 83 !!* Biological fluxes for primary production 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksimax !: ??? 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanono3 !: ??? 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatno3 !: ??? 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanonh4 !: ??? 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatnh4 !: ??? 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanopo4 !: ??? 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiatpo4 !: ??? 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimphy !: ??? 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdia !: ??? 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concdfe !: ??? 79 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concnfe !: ??? 80 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimnfe !: ??? 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdfe !: ??? 82 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimsi !: ??? 84 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksimax !: ??? 83 85 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: biron !: bioavailable fraction of iron 86 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: plig !: proportion of iron organically complexed 87 88 !!* Sinking speed 89 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3 !: POC sinking speed 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4 !: GOC sinking speed 91 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal !: Calcite and BSi sinking speeds 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsfep 93 84 94 85 95 … … 87 97 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xfracal !: ?? 88 98 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrfac !: ?? 89 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbacl !: ?? 99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: orem !: ?? 91 100 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiss !: ?? 92 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production 102 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodpoc !: Calcite production 103 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: conspoc !: Calcite production 104 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodgoc !: Calcite production 105 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: consgoc !: Calcite production 106 107 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sizen !: size of diatoms 108 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sizep !: size of diatoms 109 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sized !: size of diatoms 110 93 111 94 112 !!* Variable for chemistry of the CO2 cycle 95 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ???96 113 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak13 !: ??? 97 114 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak23 !: ??? 98 115 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksp !: ??? 99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ???100 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ???101 116 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hi !: ??? 102 117 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: excess !: ??? … … 108 123 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 109 124 110 #if defined key_kriest 111 !!* Kriest parameter for aggregation 112 REAL(wp) :: xkr_eta !: Sinking exponent 113 REAL(wp) :: xkr_zeta !: N content exponent 114 REAL(wp) :: xkr_ncontent !: N content factor 115 REAL(wp) :: xkr_massp !: 116 REAL(wp) :: xkr_mass_min, xkr_mass_max !: Minimum, Maximum mass for Aggregates 125 #if defined key_sed 126 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag 127 #else 128 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag 117 129 #endif 118 130 119 #endif120 131 !!---------------------------------------------------------------------- 121 132 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 124 135 !!---------------------------------------------------------------------- 125 136 CONTAINS 137 126 138 127 139 INTEGER FUNCTION sms_pisces_alloc() … … 130 142 !!---------------------------------------------------------------------- 131 143 USE lib_mpp , ONLY: ctl_warn 132 INTEGER :: ierr( 5) ! Local variables144 INTEGER :: ierr(10) ! Local variables 133 145 !!---------------------------------------------------------------------- 134 146 ierr(:) = 0 135 147 !* Biological fluxes for light : shared variables for pisces & lobster 136 ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), xksi(jpi,jpj), STAT=ierr(1) ) 137 ! 138 #if defined key_pisces 139 !* Biological fluxes for primary production 140 ALLOCATE( xksimax(jpi,jpj) , biron (jpi,jpj,jpk), & 141 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 142 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 143 & xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk), & 144 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 145 & xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk), & 146 & xlimsi (jpi,jpj,jpk), concdfe (jpi,jpj,jpk), & 147 & concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 148 ! 149 !* SMS for the organic matter 150 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk), & 151 & xlimbac (jpi,jpj,jpk), xdiss (jpi,jpj,jpk), & 152 & xlimbacl(jpi,jpj,jpk), prodcal(jpi,jpj,jpk), STAT=ierr(3) ) 153 154 !* Variable for chemistry of the CO2 cycle 155 ALLOCATE( akb3(jpi,jpj,jpk) , ak13 (jpi,jpj,jpk) , & 156 & ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , & 157 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 158 & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , & 159 & aphscale(jpi,jpj,jpk), STAT=ierr(4) ) 160 ! 161 !* Temperature dependancy of SMS terms 162 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr(5) ) 163 ! 164 #endif 148 ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), & 149 & heup_01(jpi,jpj) , xksi(jpi,jpj) , STAT=ierr(1) ) 150 ! 151 152 IF( ln_p4z .OR. ln_p5z ) THEN 153 !* Biological fluxes for light 154 ALLOCATE( enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk) , & 155 & etot_ndcy(jpi,jpj,jpk), emoy(jpi,jpj,jpk) , STAT=ierr(2) ) 156 157 !* Biological fluxes for primary production 158 ALLOCATE( xksimax(jpi,jpj) , biron(jpi,jpj,jpk) , STAT=ierr(3) ) 159 ! 160 !* SMS for the organic matter 161 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk) , & 162 & orem (jpi,jpj,jpk), & 163 & prodcal(jpi,jpj,jpk), xdiss (jpi,jpj,jpk), & 164 & prodpoc(jpi,jpj,jpk) , conspoc(jpi,jpj,jpk) , & 165 & prodgoc(jpi,jpj,jpk) , consgoc(jpi,jpj,jpk) , STAT=ierr(4) ) 166 167 !* Variable for chemistry of the CO2 cycle 168 ALLOCATE( ak13 (jpi,jpj,jpk) , & 169 & ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , & 170 & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , & 171 & aphscale(jpi,jpj,jpk), STAT=ierr(5) ) 172 ! 173 !* Temperature dependancy of SMS terms 174 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk), STAT=ierr(6) ) 175 ! 176 !* Sinkong speed 177 ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk), & 178 & wscal(jpi,jpj,jpk) , STAT=ierr(7) ) 179 ! 180 IF( ln_ligand ) THEN 181 ALLOCATE( plig(jpi,jpj,jpk) , wsfep(jpi,jpj,jpk) , STAT=ierr(8) ) 182 ENDIF 183 ! 184 ENDIF 185 ! 186 IF( ln_p5z ) THEN 187 ! 188 ALLOCATE( epico(jpi,jpj,jpk) , STAT=ierr(9) ) 189 190 !* Size of phytoplankton cells 191 ALLOCATE( sizen(jpi,jpj,jpk), sizep(jpi,jpj,jpk), & 192 & sized(jpi,jpj,jpk), STAT=ierr(10) ) 193 ENDIF 165 194 ! 166 195 sms_pisces_alloc = MAXVAL( ierr ) … … 170 199 END FUNCTION sms_pisces_alloc 171 200 172 #else173 !!----------------------------------------------------------------------174 !! Empty module : NO PISCES model175 !!----------------------------------------------------------------------176 #endif177 178 201 !!====================================================================== 179 202 END MODULE sms_pisces -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
r5725 r7403 5 5 !!====================================================================== 6 6 !! History : 3.5 ! 2013 (M. Vancoppenolle, O. Aumont, G. Madec), original code 7 !! Comment ! probably not properly done when the second particle export8 !! scheme (kriest) is used9 !!----------------------------------------------------------------------10 #if defined key_pisces || defined key_pisces_reduced11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 7 !!---------------------------------------------------------------------- 14 8 !! trc_ice_pisces : PISCES fake sea ice model setting … … 18 12 USE oce_trc ! Shared variables between ocean and passive tracers 19 13 USE trc ! Passive tracers common variables 20 USE phycst ! Ocean physics parameters21 14 USE sms_pisces ! PISCES Source Minus Sink variables 22 15 USE in_out_manager … … 37 30 !!---------------------------------------------------------------------- 38 31 39 IF( l k_p4z ) THEN ; CALL p4z_ice_ini ! PISCES40 ELSE ; CALL p2z_ice_ini ! LOBSTER32 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ice_ini ! PISCES 33 ELSE ; CALL p2z_ice_ini ! LOBSTER 41 34 ENDIF 42 35 … … 45 38 46 39 SUBROUTINE p4z_ice_ini 47 48 #if defined key_pisces49 40 !!---------------------------------------------------------------------- 50 41 !! *** ROUTINE p4z_ice_ini *** … … 75 66 76 67 !--- Dummy variables 77 REAL(wp), DIMENSION(jp _pisces,2):: zratio ! effective ice-ocean tracer cc ratio78 REAL(wp), DIMENSION(jp _pisces,4):: zpisc ! prescribes concentration68 REAL(wp), DIMENSION(jpmaxtrc,2) :: zratio ! effective ice-ocean tracer cc ratio 69 REAL(wp), DIMENSION(jpmaxtrc,4) :: zpisc ! prescribes concentration 79 70 ! ! 1:global, 2:Arctic, 3:Antarctic, 4:Baltic 80 71 … … 107 98 zpisc(jppo4,1) = 5.77e-7_wp / po4r 108 99 zpisc(jppoc,1) = 1.27e-6_wp 109 # if ! defined key_kriest110 100 zpisc(jpgoc,1) = 5.23e-8_wp 111 101 zpisc(jpbfe,1) = 9.84e-13_wp 112 # else113 zpisc(jpnum,1) = 0. ! could not get this value since did not use it114 # endif115 102 zpisc(jpsil,1) = 7.36e-6_wp 116 103 zpisc(jpdsi,1) = 1.07e-7_wp … … 129 116 zpisc(jpnh4,1) = 3.22e-7_wp / rno3 130 117 118 ! ln_p5z 119 zpisc(jppic,1) = 9.57e-8_wp 120 zpisc(jpnpi,1) = 9.57e-8_wp 121 zpisc(jpppi,1) = 9.57e-8_wp 122 zpisc(jppfe,1) = 1.76e-11_wp 123 zpisc(jppch,1) = 1.67e-7_wp 124 zpisc(jpnph,1) = 9.57e-8_wp 125 zpisc(jppph,1) = 9.57e-8_wp 126 zpisc(jpndi,1) = 4.24e-7_wp 127 zpisc(jppdi,1) = 4.24e-7_wp 128 zpisc(jppon,1) = 9.57e-8_wp 129 zpisc(jppop,1) = 9.57e-8_wp 130 zpisc(jpdon,1) = 2.04e-5_wp 131 zpisc(jpdop,1) = 2.04e-5_wp 132 zpisc(jpgon,1) = 5.23e-8_wp 133 zpisc(jpgop,1) = 5.23e-8_wp 134 131 135 !--- Arctic specificities (dissolved inorganic & DOM) 132 136 zpisc(jpdic,2) = 1.98e-3_wp … … 137 141 zpisc(jppo4,2) = 4.09e-7_wp / po4r 138 142 zpisc(jppoc,2) = 4.05e-7_wp 139 # if ! defined key_kriest140 143 zpisc(jpgoc,2) = 2.84e-8_wp 141 144 zpisc(jpbfe,2) = 7.03e-13_wp 142 # else143 zpisc(jpnum,2) = 0.00e-00_wp144 # endif145 145 zpisc(jpsil,2) = 6.87e-6_wp 146 146 zpisc(jpdsi,2) = 1.73e-7_wp … … 159 159 zpisc(jpnh4,2) = 6.15e-08_wp / rno3 160 160 161 ! ln_p5z 162 zpisc(jppic,2) = 5.25e-7_wp 163 zpisc(jpnpi,2) = 5.25e-7_wp 164 zpisc(jpppi,2) = 5.25e-7_wp 165 zpisc(jppfe,2) = 1.75e-11_wp 166 zpisc(jppch,2) = 1.46e-07_wp 167 zpisc(jpnph,2) = 5.25e-7_wp 168 zpisc(jppph,2) = 5.25e-7_wp 169 zpisc(jpndi,2) = 7.75e-7_wp 170 zpisc(jppdi,2) = 7.75e-7_wp 171 zpisc(jppon,2) = 4.05e-7_wp 172 zpisc(jppop,2) = 4.05e-7_wp 173 zpisc(jpdon,2) = 6.00e-6_wp 174 zpisc(jpdop,2) = 6.00e-6_wp 175 zpisc(jpgon,2) = 2.84e-8_wp 176 zpisc(jpgop,2) = 2.84e-8_wp 177 161 178 !--- Antarctic specificities (dissolved inorganic & DOM) 162 179 zpisc(jpdic,3) = 2.20e-3_wp … … 167 184 zpisc(jppo4,3) = 1.88e-6_wp / po4r 168 185 zpisc(jppoc,3) = 1.13e-6_wp 169 # if ! defined key_kriest170 186 zpisc(jpgoc,3) = 2.89e-8_wp 171 187 zpisc(jpbfe,3) = 5.63e-13_wp 172 # else173 zpisc(jpnum,3) = 0.00e-00_wp174 # endif175 188 zpisc(jpsil,3) = 4.96e-5_wp 176 189 zpisc(jpdsi,3) = 5.63e-7_wp … … 189 202 zpisc(jpnh4,3) = 3.39e-7_wp / rno3 190 203 204 ! ln_p5z 205 zpisc(jppic,3) = 8.10e-7_wp 206 zpisc(jpnpi,3) = 8.10e-7_wp 207 zpisc(jpppi,3) = 8.10e-7_wp 208 zpisc(jppfe,3) = 1.48e-11_wp 209 zpisc(jppch,3) = 2.02e-7_wp 210 zpisc(jpnph,3) = 9.57e-8_wp 211 zpisc(jppph,3) = 9.57e-8_wp 212 zpisc(jpndi,3) = 5.77e-7_wp 213 zpisc(jppdi,3) = 5.77e-7_wp 214 zpisc(jppon,3) = 1.13e-6_wp 215 zpisc(jppop,3) = 1.13e-6_wp 216 zpisc(jpdon,3) = 7.02e-6_wp 217 zpisc(jpdop,3) = 7.02e-6_wp 218 zpisc(jpgon,3) = 2.89e-8_wp 219 zpisc(jpgop,3) = 2.89e-8_wp 220 221 191 222 !--- Baltic Sea particular case for ORCA configurations 192 223 zpisc(jpdic,4) = 1.14e-3_wp … … 197 228 zpisc(jppo4,4) = 2.85e-9_wp / po4r 198 229 zpisc(jppoc,4) = 4.84e-7_wp 199 # if ! defined key_kriest200 230 zpisc(jpgoc,4) = 1.05e-8_wp 201 231 zpisc(jpbfe,4) = 4.97e-13_wp 202 # else203 zpisc(jpnum,4) = 0. ! could not get this value204 # endif205 232 zpisc(jpsil,4) = 4.91e-5_wp 206 233 zpisc(jpdsi,4) = 3.25e-7_wp … … 218 245 zpisc(jpno3,4) = 5.36e-5_wp / rno3 219 246 zpisc(jpnh4,4) = 7.18e-7_wp / rno3 247 248 ! ln_p5z 249 zpisc(jppic,4) = 6.64e-7_wp 250 zpisc(jpnpi,4) = 6.64e-7_wp 251 zpisc(jpppi,4) = 6.64e-7_wp 252 zpisc(jppfe,4) = 3.89e-11_wp 253 zpisc(jppch,4) = 1.17e-7_wp 254 zpisc(jpnph,4) = 6.64e-7_wp 255 zpisc(jppph,4) = 6.64e-7_wp 256 zpisc(jpndi,4) = 3.41e-7_wp 257 zpisc(jppdi,4) = 3.41e-7_wp 258 zpisc(jppon,4) = 4.84e-7_wp 259 zpisc(jppop,4) = 4.84e-7_wp 260 zpisc(jpdon,4) = 1.06e-5_wp 261 zpisc(jpdop,4) = 1.06e-5_wp 262 zpisc(jpgon,4) = 1.05e-8_wp 263 zpisc(jpgop,4) = 1.05e-8_wp 220 264 221 265 DO jn = jp_pcs0, jp_pcs1 … … 279 323 ! 280 324 END DO ! jn 281 #endif 282 325 ! 283 326 END SUBROUTINE p4z_ice_ini 284 327 285 328 SUBROUTINE p2z_ice_ini 286 #if defined key_pisces_reduced287 329 !!---------------------------------------------------------------------- 288 330 !! *** ROUTINE p2z_ice_ini *** … … 290 332 !! ** Purpose : Initialisation of the LOBSTER biochemical model 291 333 !!---------------------------------------------------------------------- 292 #endif293 334 END SUBROUTINE p2z_ice_ini 294 335 295 296 #else297 !!----------------------------------------------------------------------298 !! Dummy module No PISCES biochemical model299 !!----------------------------------------------------------------------300 CONTAINS301 SUBROUTINE trc_ice_ini_pisces ! Empty routine302 END SUBROUTINE trc_ice_ini_pisces303 #endif304 336 305 337 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r6325 r7403 11 11 !! 3.5 ! 2012-05 (C. Ethe) Merge PISCES-LOBSTER 12 12 !!---------------------------------------------------------------------- 13 #if defined key_pisces || defined key_pisces_reduced14 !!----------------------------------------------------------------------15 !! 'key_pisces' PISCES bio-model16 !!----------------------------------------------------------------------17 13 !! trc_ini_pisces : PISCES biochemical model initialisation 18 14 !!---------------------------------------------------------------------- 19 USE par_trc ! TOP parameters15 USE par_trc ! TOP parameters 20 16 USE oce_trc ! shared variables between ocean and passive tracers 21 17 USE trc ! passive tracers common variables 18 USE trcnam_pisces ! PISCES namelist 22 19 USE sms_pisces ! PISCES Source Minus Sink variables 23 20 … … 41 38 !!---------------------------------------------------------------------- 42 39 43 IF( lk_p4z ) THEN ; CALL p4z_ini ! PISCES 44 ELSE ; CALL p2z_ini ! LOBSTER 40 ! 41 CALL trc_nam_pisces 42 ! 43 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ini ! PISCES 44 ELSE ; CALL p2z_ini ! LOBSTER 45 45 ENDIF 46 46 … … 53 53 !! ** Purpose : Initialisation of the PISCES biochemical model 54 54 !!---------------------------------------------------------------------- 55 #if defined key_pisces56 55 ! 57 56 USE p4zsms ! Main P4Z routine … … 70 69 USE p4zlys ! Calcite saturation 71 70 USE p4zsed ! Sedimentation & burial 71 USE p4zpoc ! Remineralization of organic particles 72 USE p4zligand ! Remineralization of organic ligands 73 USE p5zlim ! Co-limitations of differents nutrients 74 USE p5zprod ! Growth rate of the 2 phyto groups 75 USE p5zmicro ! Sources and sinks of microzooplankton 76 USE p5zmeso ! Sources and sinks of mesozooplankton 77 USE p5zmort ! Mortality terms for phytoplankton 78 72 79 ! 73 80 REAL(wp), SAVE :: sco2 = 2.312e-3_wp … … 79 86 REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp 80 87 ! 81 INTEGER :: ji, jj, jk, ierr88 INTEGER :: ji, jj, jk, jn, ierr 82 89 REAL(wp) :: zcaralk, zbicarb, zco3 83 90 REAL(wp) :: ztmas, ztmas1 84 !!---------------------------------------------------------------------- 85 86 IF(lwp) WRITE(numout,*) 87 IF(lwp) WRITE(numout,*) ' p4z_ini : PISCES biochemical model initialisation' 88 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 89 90 ! Allocate PISCES arrays 91 CHARACTER(len = 20) :: cltra 92 93 !!---------------------------------------------------------------------- 94 95 IF(lwp) THEN 96 WRITE(numout,*) 97 IF( ln_p4z ) THEN 98 WRITE(numout,*) ' p4z_ini : PISCES biochemical model initialisation' 99 ELSE 100 WRITE(numout,*) ' p5z_ini : PISCES biochemical model initialisation' 101 WRITE(numout,*) ' With variable stoichiometry' 102 ENDIF 103 WRITE(numout,*) ' ~~~~~~~~~~~~~~' 104 ENDIF 105 ! 106 ! Allocate PISCES arrays 91 107 ierr = sms_pisces_alloc() 92 108 ierr = ierr + p4z_che_alloc() 93 109 ierr = ierr + p4z_sink_alloc() 94 110 ierr = ierr + p4z_opt_alloc() 95 ierr = ierr + p4z_prod_alloc()96 ierr = ierr + p4z_rem_alloc()97 111 ierr = ierr + p4z_flx_alloc() 98 112 ierr = ierr + p4z_sed_alloc() 113 ierr = ierr + p4z_rem_alloc() 114 IF( ln_p4z ) THEN 115 ierr = ierr + p4z_lim_alloc() 116 ierr = ierr + p4z_prod_alloc() 117 ELSE 118 ierr = ierr + p5z_lim_alloc() 119 ierr = ierr + p5z_prod_alloc() 120 ENDIF 99 121 ! 100 122 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 104 126 r1_ryyss = 1. / ryyss 105 127 ! 128 129 ! assign an index in trc arrays for each prognostic variables 130 DO jn = 1, jptra 131 cltra = ctrcnm(jn) 132 IF( cltra == 'DIC' ) jpdic = jn !: dissolved inoganic carbon concentration 133 IF( cltra == 'Alkalini' ) jptal = jn !: total alkalinity 134 IF( cltra == 'O2' ) jpoxy = jn !: oxygen carbon concentration 135 IF( cltra == 'CaCO3' ) jpcal = jn !: calcite concentration 136 IF( cltra == 'PO4' ) jppo4 = jn !: phosphate concentration 137 IF( cltra == 'POC' ) jppoc = jn !: small particulate organic phosphate concentration 138 IF( cltra == 'Si' ) jpsil = jn !: silicate concentration 139 IF( cltra == 'PHY' ) jpphy = jn !: phytoplancton concentration 140 IF( cltra == 'ZOO' ) jpzoo = jn !: zooplancton concentration 141 IF( cltra == 'DOC' ) jpdoc = jn !: dissolved organic carbon concentration 142 IF( cltra == 'PHY2' ) jpdia = jn !: Diatoms Concentration 143 IF( cltra == 'ZOO2' ) jpmes = jn !: Mesozooplankton Concentration 144 IF( cltra == 'DSi' ) jpdsi = jn !: Diatoms Silicate Concentration 145 IF( cltra == 'Fer' ) jpfer = jn !: Iron Concentration 146 IF( cltra == 'BFe' ) jpbfe = jn !: Big iron particles Concentration 147 IF( cltra == 'GOC' ) jpgoc = jn !: Big particulate organic phosphate concentration 148 IF( cltra == 'SFe' ) jpsfe = jn !: Small iron particles Concentration 149 IF( cltra == 'DFe' ) jpdfe = jn !: Diatoms iron Concentration 150 IF( cltra == 'GSi' ) jpgsi = jn !: (big) Silicate Concentration 151 IF( cltra == 'NFe' ) jpnfe = jn !: Nano iron Concentration 152 IF( cltra == 'NCHL' ) jpnch = jn !: Nano Chlorophyll Concentration 153 IF( cltra == 'DCHL' ) jpdch = jn !: Diatoms Chlorophyll Concentration 154 IF( cltra == 'NO3' ) jpno3 = jn !: Nitrates Concentration 155 IF( cltra == 'NH4' ) jpnh4 = jn !: Ammonium Concentration 156 IF( cltra == 'DON' ) jpdon = jn !: Dissolved organic N Concentration 157 IF( cltra == 'DOP' ) jpdop = jn !: Dissolved organic P Concentration 158 IF( cltra == 'PON' ) jppon = jn !: Small Nitrogen particle Concentration 159 IF( cltra == 'POP' ) jppop = jn !: Small Phosphorus particle Concentration 160 IF( cltra == 'GON' ) jpgon = jn !: Big Nitrogen particles Concentration 161 IF( cltra == 'GOP' ) jpgop = jn !: Big Phosphorus Concentration 162 IF( cltra == 'PHYN' ) jpnph = jn !: Nanophytoplankton N biomass 163 IF( cltra == 'PHYP' ) jppph = jn !: Nanophytoplankton P biomass 164 IF( cltra == 'DIAN' ) jpndi = jn !: Diatoms N biomass 165 IF( cltra == 'DIAP' ) jppdi = jn !: Diatoms P biomass 166 IF( cltra == 'PIC' ) jppic = jn !: Picophytoplankton C biomass 167 IF( cltra == 'PICN' ) jpnpi = jn !: Picophytoplankton N biomass 168 IF( cltra == 'PICP' ) jpppi = jn !: Picophytoplankton P biomass 169 IF( cltra == 'PFe' ) jppfe = jn !: Picophytoplankton Fe biomass 170 IF( cltra == 'LGW' ) jplgw = jn !: Weak ligands 171 IF( cltra == 'LFe' ) jpfep = jn !: Fe nanoparticle 172 ENDDO 106 173 107 174 CALL p4z_sms_init ! Maint routine … … 116 183 rdenit = ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3 117 184 rdenita = 3._wp / 5._wp 118 185 IF( ln_p5z ) THEN 186 no3rat3 = no3rat3 / rno3 187 po4rat3 = po4rat3 / po4r 188 ENDIF 119 189 120 190 ! Initialization of tracer concentration in case of no restart 121 191 !-------------------------------------------------------------- 122 IF( .NOT. ln_rsttr ) THEN 123 192 IF( .NOT.ln_rsttr ) THEN 124 193 trn(:,:,:,jpdic) = sco2 125 194 trn(:,:,:,jpdoc) = bioma0 … … 129 198 trn(:,:,:,jppo4) = po4 / po4r 130 199 trn(:,:,:,jppoc) = bioma0 131 # if ! defined key_kriest132 200 trn(:,:,:,jpgoc) = bioma0 133 201 trn(:,:,:,jpbfe) = bioma0 * 5.e-6 134 # else135 trn(:,:,:,jpnum) = bioma0 / ( 6. * xkr_massp )136 # endif137 202 trn(:,:,:,jpsil) = silic1 138 203 trn(:,:,:,jpdsi) = bioma0 * 0.15 … … 150 215 trn(:,:,:,jpno3) = no3 151 216 trn(:,:,:,jpnh4) = bioma0 152 217 IF( ln_ligand) THEN 218 trn(:,:,:,jplgw) = 0.6E-9 219 trn(:,:,:,jpfep) = 0. * 5.e-6 220 ENDIF 221 IF( ln_p5z ) THEN 222 trn(:,:,:,jpdon) = bioma0 223 trn(:,:,:,jpdop) = bioma0 224 trn(:,:,:,jppon) = bioma0 225 trn(:,:,:,jppop) = bioma0 226 trn(:,:,:,jpgon) = bioma0 227 trn(:,:,:,jpgop) = bioma0 228 trn(:,:,:,jpnph) = bioma0 229 trn(:,:,:,jppph) = bioma0 230 trn(:,:,:,jppic) = bioma0 231 trn(:,:,:,jpnpi) = bioma0 232 trn(:,:,:,jpppi) = bioma0 233 trn(:,:,:,jpndi) = bioma0 234 trn(:,:,:,jppdi) = bioma0 235 trn(:,:,:,jppfe) = bioma0 * 5.e-6 236 trn(:,:,:,jppch) = bioma0 * 12. / 55. 237 ENDIF 153 238 ! initialize the half saturation constant for silicate 154 239 ! ---------------------------------------------------- … … 158 243 159 244 160 CALL p4z_sink_init ! vertical flux of particulate organic matter 161 CALL p4z_opt_init ! Optic: PAR in the water column 162 CALL p4z_lim_init ! co-limitations by the various nutrients 163 CALL p4z_prod_init ! phytoplankton growth rate over the global ocean. 164 CALL p4z_sbc_init ! boundary conditions 165 CALL p4z_fechem_init ! Iron chemistry 166 CALL p4z_rem_init ! remineralisation 167 CALL p4z_mort_init ! phytoplankton mortality 168 CALL p4z_micro_init ! microzooplankton 169 CALL p4z_meso_init ! mesozooplankton 170 CALL p4z_lys_init ! calcite saturation 171 CALL p4z_flx_init ! gas exchange 245 CALL p4z_sink_init ! vertical flux of particulate organic matter 246 CALL p4z_opt_init ! Optic: PAR in the water column 247 IF( ln_p4z ) THEN 248 CALL p4z_lim_init ! co-limitations by the various nutrients 249 CALL p4z_prod_init ! phytoplankton growth rate over the global ocean. 250 ELSE 251 CALL p5z_lim_init ! co-limitations by the various nutrients 252 CALL p5z_prod_init ! phytoplankton growth rate over the global ocean. 253 ENDIF 254 CALL p4z_sbc_init ! boundary conditions 255 CALL p4z_fechem_init ! Iron chemistry 256 CALL p4z_rem_init ! remineralisation 257 CALL p4z_poc_init ! remineralisation of organic particles 258 IF( ln_ligand ) & 259 & CALL p4z_ligand_init ! remineralisation of organic ligands 260 261 IF( ln_p4z ) THEN 262 CALL p4z_mort_init ! phytoplankton mortality 263 CALL p4z_micro_init ! microzooplankton 264 CALL p4z_meso_init ! mesozooplankton 265 ELSE 266 CALL p5z_mort_init ! phytoplankton mortality 267 CALL p5z_micro_init ! microzooplankton 268 CALL p5z_meso_init ! mesozooplankton 269 ENDIF 270 CALL p4z_lys_init ! calcite saturation 271 IF( .NOT.l_co2cpl ) & 272 & CALL p4z_flx_init ! gas exchange 172 273 173 274 ndayflxtr = 0 … … 176 277 IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 177 278 IF(lwp) WRITE(numout,*) 178 #endif179 279 ! 180 280 END SUBROUTINE p4z_ini … … 186 286 !! ** Purpose : Initialisation of the LOBSTER biochemical model 187 287 !!---------------------------------------------------------------------- 188 #if defined key_pisces_reduced189 288 ! 190 289 USE p2zopt … … 193 292 USE p2zsed 194 293 ! 195 INTEGER :: ji, jj, jk, ierr 294 INTEGER :: ji, jj, jk, jn, ierr 295 CHARACTER(len = 10) :: cltra 196 296 !!---------------------------------------------------------------------- 197 297 … … 205 305 IF( lk_mpp ) CALL mpp_sum( ierr ) 206 306 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' ) 307 308 DO jn = 1, jptra 309 cltra = ctrcnm(jn) 310 IF( cltra == 'DET' ) jpdet = jn !: detritus [mmoleN/m3] 311 IF( cltra == 'ZOO' ) jpzoo = jn !: zooplancton concentration [mmoleN/m3] 312 IF( cltra == 'PHY' ) jpphy = jn !: phytoplancton concentration [mmoleN/m3] 313 IF( cltra == 'NO3' ) jpno3 = jn !: nitrate concentration [mmoleN/m3] 314 IF( cltra == 'NH4' ) jpnh4 = jn !: ammonium concentration [mmoleN/m3] 315 IF( cltra == 'DOM' ) jpdom = jn !: dissolved organic matter [mmoleN/m3] 316 ENDDO 317 318 jpkb = 10 ! last level where depth less than 200 m 319 DO jk = jpkm1, 1, -1 320 IF( gdept_1d(jk) > 200. ) jpkb = jk 321 END DO 322 IF (lwp) WRITE(numout,*) 323 IF (lwp) WRITE(numout,*) ' first vertical layers where biology is active (200m depth ) ', jpkb 324 IF (lwp) WRITE(numout,*) 325 jpkbm1 = jpkb - 1 326 ! 327 207 328 208 329 ! LOBSTER initialisation for GYRE : init NO3=f(density) by asklod AS Kremeur 2005-07 … … 214 335 trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 215 336 trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 216 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; trn(:,:,:,jpno3 337 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:) 217 338 ELSE WHERE ; trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 218 339 END WHERE … … 227 348 IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 228 349 IF(lwp) WRITE(numout,*) 229 #endif230 350 ! 231 351 END SUBROUTINE p2z_ini 232 #else233 !!----------------------------------------------------------------------234 !! Dummy module No PISCES biochemical model235 !!----------------------------------------------------------------------236 CONTAINS237 SUBROUTINE trc_ini_pisces ! Empty routine238 END SUBROUTINE trc_ini_pisces239 #endif240 352 241 353 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r4990 r7403 8 8 !! 1.0 ! 2003-08 (C. Ethe) module F90 9 9 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) from trcnam.pisces.h90 10 !!----------------------------------------------------------------------11 #if defined key_pisces || defined key_pisces_reduced12 !!----------------------------------------------------------------------13 !! 'key_pisces' : PISCES bio-model14 10 !!---------------------------------------------------------------------- 15 11 !! trc_nam_pisces : PISCES model namelist read … … 45 41 !! ** input : file 'namelist.trc.sms' containing the following 46 42 !! namelist: natext, natbio, natsms 47 !! natkriest ("key_kriest")48 43 !!---------------------------------------------------------------------- 49 44 !! 50 45 INTEGER :: jl, jn 51 INTEGER :: ios ! Local integer output status for namelist read 52 TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 53 TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 54 TYPE(DIAG), DIMENSION(jp_pisces_trd) :: pisdiabio 46 INTEGER :: ios, ioptio ! Local integer output status for namelist read 55 47 CHARACTER(LEN=20) :: clname 56 48 !! 57 NAMELIST/nampisdia/ pisdia3d, pisdia2d ! additional diagnostics 58 #if defined key_pisces_reduced 59 NAMELIST/nampisdbi/ pisdiabio 60 #endif 61 49 NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand 62 50 !!---------------------------------------------------------------------- 63 51 64 52 IF(lwp) WRITE(numout,*) 65 53 clname = 'namelist_pisces' 66 #if defined key_pisces 54 67 55 IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist' 68 #else69 IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read LOBSTER namelist'70 #endif71 56 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 72 57 CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 74 59 IF(lwm) CALL ctl_opn( numonp , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 75 60 ! 76 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN77 !78 ! Namelist nampisdia79 ! -------------------80 REWIND( numnatp_ref ) ! Namelist nampisdia in reference namelist : Pisces diagnostics81 READ ( numnatp_ref, nampisdia, IOSTAT = ios, ERR = 901)82 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in reference namelist', lwp )83 61 84 REWIND( numnatp_cfg ) ! Namelist nampisdia in configuration namelist : Pisces diagnostics 85 READ ( numnatp_cfg, nampisdia, IOSTAT = ios, ERR = 902 ) 86 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in configuration namelist', lwp ) 87 IF(lwm) WRITE ( numonp, nampisdia ) 62 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables 63 READ ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 64 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 88 65 89 DO jl = 1, jp_pisces_2d 90 jn = jp_pcs0_2d + jl - 1 91 ctrc2d(jn) = pisdia2d(jl)%sname 92 ctrc2l(jn) = pisdia2d(jl)%lname 93 ctrc2u(jn) = pisdia2d(jl)%units 94 END DO 66 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables 67 READ ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 68 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 69 IF(lwm) WRITE ( numonp, nampismod ) 95 70 96 DO jl = 1, jp_pisces_3d 97 jn = jp_pcs0_3d + jl - 1 98 ctrc3d(jn) = pisdia3d(jl)%sname 99 ctrc3l(jn) = pisdia3d(jl)%lname 100 ctrc3u(jn) = pisdia3d(jl)%units 101 END DO 102 103 IF(lwp) THEN ! control print 104 WRITE(numout,*) 105 WRITE(numout,*) ' Namelist : natadd' 106 DO jl = 1, jp_pisces_3d 107 jn = jp_pcs0_3d + jl - 1 108 WRITE(numout,*) ' 3d diag nb : ', jn, ' short name : ', ctrc3d(jn), & 109 & ' long name : ', ctrc3l(jn), ' unit : ', ctrc3u(jn) 110 END DO 111 WRITE(numout,*) ' ' 112 113 DO jl = 1, jp_pisces_2d 114 jn = jp_pcs0_2d + jl - 1 115 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), & 116 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn) 117 END DO 118 WRITE(numout,*) ' ' 119 ENDIF 120 ! 71 IF(lwp) THEN ! control print 72 WRITE(numout,*) ' ' 73 WRITE(numout,*) ' Flag to use LOBSTER model ln_p2z = ', ln_p2z 74 WRITE(numout,*) ' Flag to use PISCES standard model ln_p4z = ', ln_p4z 75 WRITE(numout,*) ' Flag to use PISCES quota model ln_p5z = ', ln_p5z 76 WRITE(numout,*) ' Flag to ligand ln_ligand = ', ln_ligand 77 WRITE(numout,*) ' ' 121 78 ENDIF 122 79 123 #if defined key_pisces_reduced 124 125 IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN 126 ! 127 ! Namelist nampisdbi 128 ! ------------------- 129 REWIND( numnatp_ref ) ! Namelist nampisdbi in reference namelist : Pisces add. diagnostics 130 READ ( numnatp_ref, nampisdbi, IOSTAT = ios, ERR = 903) 131 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in reference namelist', lwp ) 132 133 REWIND( numnatp_cfg ) ! Namelist nampisdbi in configuration namelist : Pisces add. diagnostics 134 READ ( numnatp_cfg, nampisdbi, IOSTAT = ios, ERR = 904 ) 135 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in configuration namelist', lwp ) 136 IF(lwm) WRITE ( numonp, nampisdbi ) 137 138 DO jl = 1, jp_pisces_trd 139 jn = jp_pcs0_trd + jl - 1 140 ctrbio(jl) = pisdiabio(jl)%sname 141 ctrbil(jl) = pisdiabio(jl)%lname 142 ctrbiu(jl) = pisdiabio(jl)%units 143 END DO 144 145 IF(lwp) THEN ! control print 146 WRITE(numout,*) 147 WRITE(numout,*) ' Namelist : nampisdbi' 148 DO jl = 1, jp_pisces_trd 149 jn = jp_pcs0_trd + jl - 1 150 WRITE(numout,*) ' biological trend No : ', jn, ' short name : ', ctrbio(jn), & 151 & ' long name : ', ctrbio(jn), ' unit : ', ctrbio(jn) 152 END DO 153 WRITE(numout,*) ' ' 154 END IF 155 ! 156 END IF 157 158 #endif 159 80 IF(lwp) THEN ! control print 81 WRITE(numout,*) ' ' 82 IF( ln_p5z ) WRITE(numout,*) ' PISCES QUOTA model is used' 83 IF( ln_p4z ) WRITE(numout,*) ' PISCES STANDARD model is used' 84 IF( ln_p2z ) WRITE(numout,*) ' LOBSTER model is used' 85 IF( ln_ligand ) WRITE(numout,*) ' Compute remineralization/dissolution of organic ligands' 86 WRITE(numout,*) ' ' 87 ENDIF 88 89 ioptio = 0 90 IF( ln_p2z ) ioptio = ioptio + 1 91 IF( ln_p4z ) ioptio = ioptio + 1 92 IF( ln_p5z ) ioptio = ioptio + 1 93 ! 94 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE PISCES model namelist nampismod' ) 95 ! 160 96 END SUBROUTINE trc_nam_pisces 161 162 #else163 !!----------------------------------------------------------------------164 !! Dummy module : No PISCES bio-model165 !!----------------------------------------------------------------------166 CONTAINS167 SUBROUTINE trc_nam_pisces ! Empty routine168 END SUBROUTINE trc_nam_pisces169 #endif170 97 171 98 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r4147 r7403 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces || defined key_pisces_reduced10 !!----------------------------------------------------------------------11 !! 'key_pisces' PISCES bio-model12 !!----------------------------------------------------------------------13 9 !! trcsms_pisces : Time loop of passive tracers sms 14 10 !!---------------------------------------------------------------------- 15 11 USE par_pisces 12 USE sms_pisces 16 13 USE p4zsms 17 14 USE p2zsms … … 48 45 !!--------------------------------------------------------------------- 49 46 ! 50 IF( l k_p4z ) THEN ; CALL p4z_sms( kt ) ! PISCES51 ELSE ; CALL p2z_sms( kt ) ! LOBSTER47 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_sms( kt ) ! PISCES 48 ELSE ; CALL p2z_sms( kt ) ! LOBSTER 52 49 ENDIF 53 50 … … 55 52 END SUBROUTINE trc_sms_pisces 56 53 57 #else58 !!======================================================================59 !! Dummy module : No PISCES bio-model60 !!======================================================================61 CONTAINS62 SUBROUTINE trc_sms_pisces( kt ) ! Empty routine63 INTEGER, INTENT( in ) :: kt64 WRITE(*,*) 'trc_sms_pisces: You should not have seen this print! error?', kt65 END SUBROUTINE trc_sms_pisces66 #endif67 68 54 !!====================================================================== 69 55 END MODULE trcsms_pisces -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
r6140 r7403 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && defined key_iomput && ( defined key_pisces || defined key_pisces_reduced ) 9 !!---------------------------------------------------------------------- 10 !! 'key_pisces or key_pisces_reduced' PISCES model 8 #if defined key_top && defined key_iomput 11 9 !!---------------------------------------------------------------------- 12 10 !! trc_wri_pisces : outputs of concentration fields … … 42 40 ! write the tracer concentrations in the file 43 41 ! --------------------------------------- 44 #if defined key_pisces_reduced 45 DO jn = jp_pcs0, jp_pcs146 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer47 CALL iom_put( cltra, trn(:,:,:,jn) )48 END DO49 #else 50 DO jn = jp_pcs0, jp_pcs151 zfact = 1.0e+652 IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+653 IF( jn == jppo4 ) zfact = po4r * 1.0e+654 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer55 IF( iom_use( cltra ) ) CALL iom_put( cltra, trn(:,:,:,jn) * zfact )56 END DO42 IF( ln_p2z ) THEN 43 DO jn = jp_pcs0, jp_pcs1 44 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 45 CALL iom_put( cltra, trn(:,:,:,jn) ) 46 END DO 47 ELSE 48 DO jn = jp_pcs0, jp_pcs1 49 zfact = 1.0e+6 50 IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6 51 IF( jn == jppo4 ) zfact = po4r * 1.0e+6 52 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 53 IF( iom_use( cltra ) ) CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 54 END DO 57 55 58 IF( iom_use( "INTDIC" ) ) THEN ! DIC content in kg/m2 59 zdic(:,:) = 0. 60 DO jk = 1, jpkm1 61 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 62 ENDDO 63 CALL iom_put( 'INTDIC', zdic ) 64 ENDIF 65 ! 66 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 67 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 68 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 69 DO jk = 2, jpkm1 70 DO jj = 1, jpj 71 DO ji = 1, jpi 72 IF( tmask(ji,jj,jk) == 1 ) then 73 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 74 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 75 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 56 IF( iom_use( "INTDIC" ) ) THEN ! DIC content in kg/m2 57 zdic(:,:) = 0. 58 DO jk = 1, jpkm1 59 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 60 ENDDO 61 CALL iom_put( 'INTDIC', zdic ) 62 ENDIF 63 ! 64 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 65 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 66 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 67 DO jk = 2, jpkm1 68 DO jj = 1, jpj 69 DO ji = 1, jpi 70 IF( tmask(ji,jj,jk) == 1 ) then 71 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 72 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 73 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 74 ENDIF 76 75 ENDIF 77 END IF76 END DO 78 77 END DO 79 78 END DO 80 END DO 81 ! 82 CALL iom_put('O2MIN' , zo2min ) ! oxygen minimum concentration 83 CALL iom_put('ZO2MIN', zdepo2min ) ! depth of oxygen minimum concentration 84 ! 85 ENDIF 86 #endif 79 ! 80 CALL iom_put('O2MIN' , zo2min ) ! oxygen minimum concentration 81 CALL iom_put('ZO2MIN', zdepo2min ) ! depth of oxygen minimum concentration 82 ! 83 ENDIF 84 ENDIF 87 85 ! 88 86 END SUBROUTINE trc_wri_pisces -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r6140 r7403 57 57 INTEGER :: nadv ! chosen advection scheme 58 58 ! 59 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt60 ! ! except at nitrrc000 (=rdt) if neuler=061 62 59 !! * Substitutions 63 60 # include "vectopt_loop_substitute.h90" … … 87 84 ! 88 85 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 89 !90 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc00091 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping)92 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+193 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog)94 ENDIF95 86 ! !== effective transport ==! 96 87 DO jk = 1, jpkm1 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r6140 r7403 43 43 44 44 PUBLIC trc_nxt ! routine called by step.F90 45 46 REAL(wp) :: r2dttrc47 45 48 46 !!---------------------------------------------------------------------- … … 100 98 101 99 IF( lk_bdy ) CALL trc_bdy( kt ) 102 103 ! ! set time step size (Euler/Leapfrog)104 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dttrc = rdttrc ! at nittrc000 (Euler)105 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dttrc = 2.* rdttrc ! at nit000 or nit000+1 (Leapfrog)106 ENDIF107 100 108 101 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r5836 r7403 62 62 ENDIF 63 63 64 IF( lk_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1 ) ! CFC model 65 IF( lk_c14b ) CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1 ) ! bomb C14 66 IF( lk_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' ) ! PISCES model 67 IF( lk_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1 ) ! MY_TRC model 64 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE 65 IF( ll_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1 ) ! CFC model 66 IF( ln_c14 ) CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14 ) ! C14 67 IF( ln_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model 68 IF( ln_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1 ) ! MY_TRC model 68 69 69 70 ! … … 213 214 IF( l_trdtrc ) THEN 214 215 ! 215 zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc) )216 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 216 217 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 217 218 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r6942 r7403 84 84 END SELECT 85 85 86 IF( ln_top_euler) THEN87 r2dt = rdttrc ! = rdttrc (use Euler time stepping)88 ELSE89 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc00090 r2dt = rdttrc ! = rdttrc (restarting with Euler time stepping)91 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+192 r2dt = 2. * rdttrc ! = 2 rdttrc (leapfrog)93 ENDIF94 ENDIF95 96 97 86 IF( kt == nittrc000 ) THEN 98 87 IF(lwp) WRITE(numout,*) … … 160 149 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 161 150 IF ( zdtra < 0. ) THEN 162 zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn )151 zratio = -zdtra * zse3t * r2dttrc / ( trn(ji,jj,1,jn) + zrtrn ) 163 152 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 164 153 ENDIF -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r6140 r7403 35 35 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 36 36 ! ! defined from ln_zdf... namlist logicals) 37 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt38 ! ! except at nittrc000 (=rdt) if neuler=039 40 37 !! * Substitutions 41 38 # include "zdfddm_substitute.h90" … … 63 60 IF( nn_timing == 1 ) CALL timing_start('trc_zdf') 64 61 ! 65 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc00066 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping)67 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+168 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog)69 ENDIF70 71 62 IF( l_trdtrc ) THEN 72 63 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r6140 r7403 41 41 PUBLIC trd_mxl_trc 42 42 PUBLIC trd_mxl_trc_alloc 43 PUBLIC trd_mxl_bio44 43 PUBLIC trd_mxl_trc_init 45 44 PUBLIC trd_mxl_trc_zint 46 PUBLIC trd_mxl_bio_zint47 45 48 46 CHARACTER (LEN=40) :: clhstnam ! name of the trends NetCDF file 49 47 INTEGER :: nmoymltrd 50 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndextrd1 51 INTEGER, DIMENSION(jptra) :: nidtrd, nh_t 48 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndextrd1, nidtrd, nh_t 52 49 INTEGER :: ndimtrd1 53 50 INTEGER, SAVE :: ionce, icount 54 #if defined key_pisces_reduced55 INTEGER :: nidtrdbio, nh_tb56 INTEGER, SAVE :: ioncebio, icountbio57 INTEGER, SAVE :: nmoymltrdbio58 #endif59 51 LOGICAL :: llwarn = .TRUE. ! this should always be .TRUE. 60 52 LOGICAL :: lldebug = .TRUE. 61 53 62 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztmltrd2 ! 63 #if defined key_pisces_reduced64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztmltrdbio2 ! only needed for mean diagnostics in trd_mxl_bio()65 #endif66 55 67 56 !! * Substitutions … … 79 68 !!---------------------------------------------------------------------- 80 69 ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) , & 81 #if defined key_pisces_reduced 82 & ztmltrdbio2(jpi,jpj,jpdiabio) , & 83 #endif 84 & ndextrd1(jpi*jpj) , STAT=trd_mxl_trc_alloc) 70 & ndextrd1(jpi*jpj), nidtrd(jptra), nh_t(jptra), STAT=trd_mxl_trc_alloc) 85 71 ! 86 72 IF( lk_mpp ) CALL mpp_sum ( trd_mxl_trc_alloc ) … … 131 117 SELECT CASE ( nn_ctls_trc ) ! choice of the control surface 132 118 CASE ( -2 ) ; STOP 'trdmxl_trc : not ready ' ! -> isopycnal surface (see ???) 133 #if defined key_pisces || defined key_pisces_reduced134 119 CASE ( -1 ) ; nmld_trc(:,:) = neln(:,:) ! -> euphotic layer with light criterion 135 #endif136 120 CASE ( 0 ) ; nmld_trc(:,:) = nmln(:,:) ! -> ML with density criterion (see zdfmxl) 137 121 CASE ( 1 ) ; nmld_trc(:,:) = nbol_trc(:,:) ! -> read index from file … … 207 191 ! 208 192 END SUBROUTINE trd_mxl_trc_zint 209 210 211 SUBROUTINE trd_mxl_bio_zint( ptrc_trdmxl, ktrd )212 !!----------------------------------------------------------------------213 !! *** ROUTINE trd_mxl_bio_zint ***214 !!215 !! ** Purpose : Compute the vertical average of the 3D fields given as arguments216 !! to the subroutine. This vertical average is performed from ocean217 !! surface down to a chosen control surface.218 !!219 !! ** Method/usage :220 !! The control surface can be either a mixed layer depth (time varying)221 !! or a fixed surface (jk level or bowl).222 !! Choose control surface with nctls in namelist NAMTRD :223 !! nctls_trc = 0 : use mixed layer with density criterion224 !! nctls_trc = 1 : read index from file 'ctlsurf_idx'225 !! nctls_trc > 1 : use fixed level surface jk = nctls_trc226 !! Note: in the remainder of the routine, the volume between the227 !! surface and the control surface is called "mixed-layer"228 !!----------------------------------------------------------------------229 !!230 INTEGER , INTENT(in) :: ktrd ! bio trend index231 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrc_trdmxl ! passive trc trend232 #if defined key_pisces_reduced233 !234 INTEGER :: ji, jj, jk, isum235 REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk236 !!----------------------------------------------------------------------237 238 CALL wrk_alloc( jpi, jpj, zvlmsk )239 240 ! I. Definition of control surface and integration weights241 ! --------------------------------------------------------242 ! ==> only once per time step <==243 244 IF( icountbio == 1 ) THEN245 !246 tmltrd_bio(:,:,:) = 0.e0 ! <<< reset trend arrays to zero247 ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer248 SELECT CASE ( nn_ctls_trc ) ! choice of the control surface249 CASE ( -2 ) ; STOP 'trdmxl_trc : not ready ' ! -> isopycnal surface (see ???)250 CASE ( -1 ) ; nmld_trc(:,:) = neln(:,:) ! -> euphotic layer with light criterion251 CASE ( 0 ) ; nmld_trc(:,:) = nmln(:,:) ! -> ML with density criterion (see zdfmxl)252 CASE ( 1 ) ; nmld_trc(:,:) = nbol_trc(:,:) ! -> read index from file253 CASE ( 2: ) ; nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 )254 nmld_trc(:,:) = nn_ctls_trc + 1 ! -> model level255 END SELECT256 257 ! ... Compute ndextrd1 and ndimtrd1 only once258 IF( ioncebio == 1 ) THEN259 !260 ! Check of validity : nmld_trc(ji,jj) <= jpktrd_trc261 isum = 0262 zvlmsk(:,:) = 0.e0263 264 IF( jpktrd_trc < jpk ) THEN265 DO jj = 1, jpj266 DO ji = 1, jpi267 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN268 zvlmsk(ji,jj) = tmask(ji,jj,1)269 ELSE270 isum = isum + 1271 zvlmsk(ji,jj) = 0.272 END IF273 END DO274 END DO275 END IF276 277 ! Index of ocean points (2D only)278 IF( isum > 0 ) THEN279 WRITE(numout,*)' tmltrd_trc : Number of invalid points nmld_trc > jpktrd', isum280 CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 )281 ELSE282 CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 )283 END IF284 285 ioncebio = 0 ! no more pass here286 !287 END IF ! ( ioncebio == 1 )288 289 ! ... Weights for vertical averaging290 wkx_trc(:,:,:) = 0.e0291 DO jk = 1, jpktrd_trc ! initialize wkx_trc with vertical scale factor in mixed-layer292 DO jj = 1,jpj293 DO ji = 1,jpi294 IF( jk - nmld_trc(ji,jj) < 0. ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)295 END DO296 END DO297 END DO298 299 rmld_trc(:,:) = 0.300 DO jk = 1, jpktrd_trc ! compute mixed-layer depth : rmld_trc301 rmld_trc(:,:) = rmld_trc(:,:) + wkx_trc(:,:,jk)302 END DO303 304 DO jk = 1, jpktrd_trc ! compute integration weights305 wkx_trc(:,:,jk) = wkx_trc(:,:,jk) / MAX( 1., rmld_trc(:,:) )306 END DO307 308 icountbio = 0 ! <<< flag = off : control surface & integr. weights309 ! ! computed only once per time step310 END IF ! ( icountbio == 1 )311 312 ! II. Vertical integration of trends in the mixed-layer313 ! -----------------------------------------------------314 315 316 DO jk = 1, jpktrd_trc317 tmltrd_bio(:,:,ktrd) = tmltrd_bio(:,:,ktrd) + ptrc_trdmxl(:,:,jk) * wkx_trc(:,:,jk)318 END DO319 320 CALL wrk_dealloc( jpi, jpj, zvlmsk )321 #endif322 !323 END SUBROUTINE trd_mxl_bio_zint324 193 325 194 … … 877 746 878 747 879 SUBROUTINE trd_mxl_bio( kt )880 !!----------------------------------------------------------------------881 !! *** ROUTINE trd_mld ***882 !!883 !! ** Purpose : Compute and cumulate the mixed layer biological trends over an analysis884 !! period, and write NetCDF outputs.885 !!886 !! ** Method/usage :887 !! The stored trends can be chosen twofold (according to the ln_trdmxl_trc_instant888 !! logical namelist variable) :889 !! 1) to explain the difference between initial and final890 !! mixed-layer T & S (where initial and final relate to the891 !! current analysis window, defined by ntrd in the namelist)892 !! 2) to explain the difference between the current and previous893 !! TIME-AVERAGED mixed-layer T & S (where time-averaging is894 !! performed over each analysis window).895 !!896 !! ** Consistency check :897 !! If the control surface is fixed ( nctls > 1 ), the residual term (dh/dt898 !! entrainment) should be zero, at machine accuracy. Note that in the case899 !! of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO900 !! over the first two analysis windows (except if restart).901 !! N.B. For ORCA2_LIM, use e.g. ntrd=5, ucf=1., nctls=8902 !! for checking residuals.903 !! On a NEC-SX5 computer, this typically leads to:904 !! O(1.e-20) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.false.905 !! O(1.e-21) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.true.906 !!907 !! ** Action :908 !! At each time step, mixed-layer averaged trends are stored in the909 !! tmltrd(:,:,jpmxl_xxx) array (see trdmxl_oce.F90 for definitions of jpmxl_xxx).910 !! This array is known when trd_mld is called, at the end of the stp subroutine,911 !! except for the purely vertical K_z diffusion term, which is embedded in the912 !! lateral diffusion trend.913 !!914 !! In I), this K_z term is diagnosed and stored, thus its contribution is removed915 !! from the lateral diffusion trend.916 !! In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative917 !! arrays are updated.918 !! In III), called only once per analysis window, we compute the total trends,919 !! along with the residuals and the Asselin correction terms.920 !! In IV), the appropriate trends are written in the trends NetCDF file.921 !!922 !! References :923 !! - Vialard & al.924 !! - See NEMO documentation (in preparation)925 !!----------------------------------------------------------------------926 INTEGER, INTENT( in ) :: kt ! ocean time-step index927 #if defined key_pisces_reduced928 INTEGER :: jl, it, itmod929 LOGICAL :: llwarn = .TRUE., lldebug = .TRUE.930 REAL(wp) :: zfn, zfn2931 !!----------------------------------------------------------------------932 ! ... Warnings933 IF( nn_dttrc /= 1 ) CALL ctl_stop( " Be careful, trends diags never validated " )934 935 ! ======================================================================936 ! II. Cumulate the trends over the analysis window937 ! ======================================================================938 939 ztmltrdbio2(:,:,:) = 0.e0 ! <<< reset arrays to zero940 941 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window942 ! ------------------------------------------------------------------------943 IF( kt == nittrc000 + nn_dttrc ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)944 !945 tmltrd_csum_ub_bio (:,:,:) = 0.e0946 !947 END IF948 949 ! II.4 Cumulated trends over the analysis period950 ! ----------------------------------------------951 !952 ! [ 1rst analysis window ] [ 2nd analysis window ]953 !954 !955 ! o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps956 ! ntrd 2*ntrd etc.957 ! 1 2 3 4 =5 e.g. =10958 !959 IF( ( kt >= 2 ).OR.( ln_rsttr ) ) THEN960 !961 nmoymltrdbio = nmoymltrdbio + 1962 963 ! ... Trends associated with the time mean of the ML passive tracers964 tmltrd_sum_bio (:,:,:) = tmltrd_sum_bio (:,:,:) + tmltrd_bio (:,:,:)965 tmltrd_csum_ln_bio(:,:,:) = tmltrd_csum_ln_bio(:,:,:) + tmltrd_sum_bio(:,:,:)966 !967 END IF968 969 ! ======================================================================970 ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD)971 ! ======================================================================972 973 ! Convert to appropriate physical units974 tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * rn_ucf_trc975 976 MODULO_NTRD : IF( MOD( kt, nn_trd_trc ) == 0 ) THEN ! nitend MUST be multiple of ntrd977 !978 zfn = float(nmoymltrdbio) ; zfn2 = zfn * zfn979 980 ! III.1 Prepare fields for output ("instantaneous" diagnostics)981 ! -------------------------------------------------------------982 983 #if defined key_diainstant984 STOP 'tmltrd_bio : key_diainstant was never checked within trdmxl. Comment this to proceed.'985 #endif986 ! III.2 Prepare fields for output ("mean" diagnostics)987 ! ----------------------------------------------------988 989 ztmltrdbio2(:,:,:) = tmltrd_csum_ub_bio(:,:,:) + tmltrd_csum_ln_bio(:,:,:)990 991 !-- Lateral boundary conditions992 IF ( cp_cfg .NE. 'gyre' ) THEN ! other than GYRE configuration993 ! ES_B27_CD_WARN : lbc inutile GYRE, cf. + haut994 DO jn = 1, jpdiabio995 CALL lbc_lnk( ztmltrdbio2(:,:,jn), 'T', 1. )996 ENDDO997 ENDIF998 999 IF( lldebug ) THEN1000 !1001 WRITE(numout,*) 'trd_mxl_bio : write trends in the Mixed Layer for debugging process:'1002 WRITE(numout,*) '~~~~~~~~~~~ '1003 WRITE(numout,*) 'TRC kt = ', kt, 'nmoymltrdbio = ', nmoymltrdbio1004 WRITE(numout,*)1005 1006 DO jl = 1, jpdiabio1007 IF( ln_trdmxl_trc_instant ) THEN1008 WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX = ', jl, &1009 & ' SUM tmltrd_bio : ', SUM2D(tmltrd_bio(:,:,jl))1010 ELSE1011 WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX = ', jl, &1012 & ' SUM ztmltrdbio2 : ', SUM2D(ztmltrdbio2(:,:,jl))1013 endif1014 END DO1015 1016 97 FORMAT(a10, i3, 2x, a30, i3, a20, 2x, g20.10)1017 98 FORMAT(a10, i3, 2x, a30, 2x, g20.10)1018 99 FORMAT('TRC jj =', i3,' : ', 10(g10.3,2x))1019 WRITE(numout,*)1020 !1021 ENDIF1022 1023 ! III.3 Time evolution array swap1024 ! -------------------------------1025 1026 ! For passive tracer mean diagnostics1027 tmltrd_csum_ub_bio (:,:,:) = zfn * tmltrd_sum_bio(:,:,:) - tmltrd_csum_ln_bio(:,:,:)1028 1029 ! III.4 Convert to appropriate physical units1030 ! -------------------------------------------1031 ztmltrdbio2 (:,:,:) = ztmltrdbio2 (:,:,:) * rn_ucf_trc/zfn21032 1033 END IF MODULO_NTRD1034 1035 ! ======================================================================1036 ! IV. Write trends in the NetCDF file1037 ! ======================================================================1038 1039 ! IV.1 Code for IOIPSL/NetCDF output1040 ! ----------------------------------1041 1042 ! define time axis1043 itmod = kt - nittrc000 + 11044 it = kt1045 1046 IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN1047 WRITE(numout,*) ' '1048 WRITE(numout,*) 'trd_mxl_bio : write ML bio trends in the NetCDF file :'1049 WRITE(numout,*) '~~~~~~~~~~~ '1050 WRITE(numout,*) ' ', TRIM(clhstnam), ' at kt = ', kt1051 WRITE(numout,*) ' N.B. nmoymltrdbio = ', nmoymltrdbio1052 WRITE(numout,*) ' '1053 END IF1054 1055 1056 ! 2. Start writing data1057 ! ---------------------1058 1059 NETCDF_OUTPUT : IF( ln_trdmxl_trc_instant ) THEN ! <<< write the trends for passive tracer instant. diags1060 !1061 DO jl = 1, jpdiabio1062 CALL histwrite( nidtrdbio,TRIM("ML_"//ctrd_bio(jl,2)) , &1063 & it, tmltrd_bio(:,:,jl), ndimtrd1, ndextrd1 )1064 END DO1065 1066 1067 IF( kt == nitend ) CALL histclo( nidtrdbio )1068 1069 ELSE ! <<< write the trends for passive tracer mean diagnostics1070 1071 DO jl = 1, jpdiabio1072 CALL histwrite( nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)) , &1073 & it, ztmltrdbio2(:,:,jl), ndimtrd1, ndextrd1 )1074 END DO1075 1076 IF( kt == nitend ) CALL histclo( nidtrdbio )1077 !1078 END IF NETCDF_OUTPUT1079 1080 ! Compute the control surface (for next time step) : flag = on1081 icountbio = 11082 1083 1084 1085 IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN1086 !1087 ! III.5 Reset cumulative arrays to zero1088 ! -------------------------------------1089 nmoymltrdbio = 01090 tmltrd_csum_ln_bio (:,:,:) = 0.e01091 tmltrd_sum_bio (:,:,:) = 0.e01092 END IF1093 1094 ! ======================================================================1095 ! Write restart file1096 ! ======================================================================1097 1098 ! restart write is done in trd_mxl_trc_write which is called by trd_mxl_bio (Marina)1099 !1100 #endif1101 END SUBROUTINE trd_mxl_bio1102 1103 1104 748 REAL FUNCTION sum2d( ztab ) 1105 749 !!---------------------------------------------------------------------- … … 1191 835 tmltrd_csum_ln_trc (:,:,:,:) = 0.e0 ; rmld_sum_trc (:,:) = 0.e0 1192 836 1193 #if defined key_pisces_reduced1194 nmoymltrdbio = 01195 tmltrd_sum_bio (:,:,:) = 0.e0 ; tmltrd_csum_ln_bio (:,:,:) = 0.e01196 DO jl = 1, jp_pisces_trd1197 ctrd_bio(jl,1) = ctrbil(jl) ! long name1198 ctrd_bio(jl,2) = ctrbio(jl) ! short name1199 ENDDO1200 #endif1201 1202 837 IF( ln_rsttr .AND. ln_trdmxl_trc_restart ) THEN 1203 838 CALL trd_mxl_trc_rst_read … … 1208 843 tml_sumb_trc (:,:,:) = 0.e0 ; tmltrd_csum_ub_trc (:,:,:,:) = 0.e0 ! mean 1209 844 tmltrd_atf_sumb_trc(:,:,:) = 0.e0 ; tmltrd_rad_sumb_trc(:,:,:) = 0.e0 1210 #if defined key_pisces_reduced1211 tmltrd_csum_ub_bio (:,:,:) = 0.e01212 #endif1213 845 1214 846 ENDIF … … 1216 848 icount = 1 ; ionce = 1 ! open specifier 1217 849 1218 #if defined key_pisces_reduced1219 icountbio = 1 ; ioncebio = 1 ! open specifier1220 #endif1221 850 1222 851 ! I.3 Read control surface from file ctlsurf_idx … … 1308 937 END DO 1309 938 1310 #if defined key_pisces_reduced1311 !-- Create a NetCDF file and enter the define mode1312 CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' )1313 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, &1314 & 1, jpi, 1, jpj, iiter, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set )1315 #endif1316 1317 939 !-- Define physical units 1318 940 IF( rn_ucf_trc == 1. ) THEN … … 1354 976 END DO 1355 977 1356 #if defined key_pisces_reduced1357 DO jl = 1, jp_pisces_trd1358 CALL histdef(nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)), TRIM(clmxl//" ML_"//ctrd_bio(jl,1)) , &1359 & cltrcu, jpi, jpj, nh_tb, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean1360 END DO ! if zsto=rdt above1361 #endif1362 1363 978 !-- Leave IOIPSL/NetCDF define mode 1364 979 DO jn = 1, jptra … … 1366 981 END DO 1367 982 1368 #if defined key_pisces_reduced1369 !-- Leave IOIPSL/NetCDF define mode1370 CALL histend( nidtrdbio, snc4set )1371 1372 983 IF(lwp) WRITE(numout,*) 1373 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization for ML bio trends'1374 #endif1375 984 1376 985 END SUBROUTINE trd_mxl_trc_init … … 1385 994 WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 1386 995 END SUBROUTINE trd_mxl_trc 1387 SUBROUTINE trd_mxl_bio( kt )1388 INTEGER, INTENT( in) :: kt1389 WRITE(*,*) 'trd_mxl_bio: You should not have seen this print! error?', kt1390 END SUBROUTINE trd_mxl_bio1391 996 SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 1392 997 INTEGER , INTENT( in ) :: ktrd, kjn ! ocean trend index and passive tracer rank -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
r6140 r7403 107 107 END DO ! tracer loop 108 108 ! ! =========== 109 #if defined key_pisces_reduced110 DO jl = 1, jp_pisces_trd111 CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )112 ENDDO113 #endif114 115 109 ENDIF 116 110 … … 188 182 ! ! =========== 189 183 190 #if defined key_pisces_reduced191 DO jl = 1, jp_pisces_trd192 CALL iom_get( inum, jpdom_autoglo, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )193 ENDDO194 #endif195 196 184 CALL iom_close( inum ) 197 185 ENDIF -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
r5836 r7403 22 22 CHARACTER(len=50) :: cn_trdrst_trc_in !: suffix of pass. tracer restart name (input) 23 23 CHARACTER(len=50) :: cn_trdrst_trc_out !: suffix of pass. tracer restart name (output) 24 LOGICAL, DIMENSION( jptra):: ln_trdtrc !: large trends diagnostic to write or not (namelist)24 LOGICAL, DIMENSION(:), ALLOCATABLE :: ln_trdtrc !: large trends diagnostic to write or not (namelist) 25 25 26 26 # if defined key_trdtrc && defined key_iomput … … 106 106 # endif 107 107 108 # if defined key_pisces_reduced109 CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2)110 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: &111 tmltrd_bio, & !: \ biological contributions to the total trend ,112 !: / cumulated over the current analysis window113 tmltrd_sum_bio, & !: sum of these trends over the analysis period114 tmltrd_csum_ln_bio, & !: now cumulated sum of trends over the "lower triangle"115 tmltrd_csum_ub_bio !: before (prev. analysis period) cumulated sum over the116 !: upper triangle117 #endif118 108 !!---------------------------------------------------------------------- 119 109 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 154 144 #endif 155 145 ! 156 # if defined key_pisces_reduced157 ALLOCATE( tmltrd_bio (jpi,jpj,jpdiabio) , &158 & tmltrd_sum_bio (jpi,jpj,jpdiabio) , &159 & tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) , &160 & tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) )161 # endif162 !163 146 trd_trc_oce_alloc = MAXVAL(ierr) 164 147 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5836 r7403 31 31 USE phycst !* physical constants * 32 32 USE c1d !* 1D configuration 33 33 34 USE dom_oce !* model domain * 34 35 … … 63 64 USE sbc_oce , ONLY : fmmflx => fmmflx !: freshwater budget: volume flux [Kg/m2/s] 64 65 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] 66 USE sbc_oce , ONLY : rnf_b => rnf_b !: river runoff at previus step [Kg/m2/s] 65 67 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Diurnal Cycle 68 USE sbc_oce , ONLY : ln_cpl => ln_cpl !: ocean-atmosphere coupled formulation 66 69 USE sbc_oce , ONLY : ncpl_qsr_freq => ncpl_qsr_freq !: qsr coupling frequency per days from atmospher 67 70 USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths 68 71 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) 69 72 USE sbc_oce , ONLY : nn_ice_embd => nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean 73 USE sbc_oce , ONLY : atm_co2 => atm_co2 ! atmospheric pCO2 70 74 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 71 75 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction … … 75 79 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 76 80 USE sbcrnf , ONLY : nk_rnf => nk_rnf !: depth of runoff in model level 81 USE sbcrnf , ONLY : rn_rfact => rn_rfact !: multiplicative factor for runoff 77 82 78 83 USE trc_oce … … 114 119 USE zdfmxl , ONLY : hmlpt => hmlpt !: mixed layer depth at t-points (m) 115 120 116 USE diaar5 , ONLY : lk_diaar5 => lk_diaar5117 121 #else 118 122 !!---------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r4529 r7403 10 10 !!---------------------------------------------------------------------- 11 11 USE par_kind ! kind parameters 12 USE par_pisces ! PISCES model parameters 13 USE par_cfc ! CFCs tracers parameters 14 USE par_c14 ! C14 tracer parameters 15 USE par_age ! AGE tracer parameters 16 USE par_my_trc ! MY_TRC model parameters 12 17 ! 13 USE par_pisces ! PISCES model14 USE par_c14b ! C14 bomb tracer15 USE par_cfc ! CFC 11 and 12 tracers16 USE par_my_trc ! user defined passive tracers17 18 18 19 IMPLICIT NONE 19 20 20 ! Passive tracers : Maximum number of tracers. Needed to define data structures 21 ! --------------- 22 INTEGER, PUBLIC, PARAMETER :: jpmaxtrc = 100 21 INTEGER, PUBLIC, PARAMETER :: jpmaxtrc = 100 ! Maximum number of tracers 23 22 24 ! Passive tracers : Total size 25 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 26 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 27 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 28 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 29 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 31 32 ! 1D configuration ("key_c1d") 33 ! ----------------- 34 # if defined key_c1d 35 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .TRUE. !: 1D pass. tracer configuration flag 36 # else 37 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .FALSE. !: 1D pass. tracer configuration flag 38 # endif 23 INTEGER, PUBLIC :: jptra !: Total number of passive tracers 24 INTEGER, PUBLIC :: jp_pisces !: number of passive tracers in PISCES model 25 INTEGER, PUBLIC :: jp_cfc !: number of CFC passive tracers 26 INTEGER, PUBLIC :: jp_my_trc !: number of passive tracers in MY_TRC model 27 INTEGER, PUBLIC :: jp_bgc !: number of passive tracers for the BGC model 39 28 40 REAL(wp), PUBLIC :: rtrn = 0.5 * EPSILON( 1.e0 ) !: truncation value 29 INTEGER, PUBLIC :: jp_dia3d !: number of 3D diagnostic variables 30 INTEGER, PUBLIC :: jp_dia2d !: number of 2D diagnostic variables 41 31 42 !!---------------------------------------------------------------------- 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 !!====================================================================== 32 LOGICAL, PUBLIC :: ln_pisces !: PISCES flag 33 LOGICAL, PUBLIC :: ln_age !: AGE flag 34 LOGICAL, PUBLIC :: ln_cfc11 !: CFC11 flag 35 LOGICAL, PUBLIC :: ln_cfc12 !: CFC12 flag 36 LOGICAL, PUBLIC :: ln_sf6 !: SF6 flag 37 LOGICAL, PUBLIC :: ll_cfc !: CFC flag 38 LOGICAL, PUBLIC :: ln_c14 !: C14 flag 39 LOGICAL, PUBLIC :: ln_my_trc !: MY_TRC flag 40 41 REAL(wp), PUBLIC :: rtrn = 0.5 * EPSILON( 1.e0 ) !: truncation value 42 47 43 END MODULE par_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r4520 r7403 70 70 INTEGER :: overlap, jn, js, sind, eind, kdir, j_id 71 71 REAL(wp) :: zsum, zvctl 72 CHARACTER (len=20), DIMENSION(jptra) :: cl72 CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) :: cl 73 73 CHARACTER (len=10) :: cl2 74 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask, ztab3d … … 76 76 77 77 CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d ) 78 ALLOCATE( cl(jptra) ) 78 79 ! ! Arrays, scalars initialization 79 80 overlap = 0 … … 152 153 ! 153 154 CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d ) 155 DEALLOCATE( cl ) 154 156 ! 155 157 END SUBROUTINE prt_ctl_trc -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trc.F90
r6140 r7403 28 28 INTEGER, PUBLIC :: numnat_cfg = -1 !: logical unit for the reference passive tracer namelist_top_cfg 29 29 INTEGER, PUBLIC :: numont = -1 !: logical unit for the reference passive tracer namelist output output.namelist.top 30 INTEGER, PUBLIC :: numtrc_ref = -1 !: logical unit for the reference passive tracer namelist_top_ref 31 INTEGER, PUBLIC :: numtrc_cfg = -1 !: logical unit for the reference passive tracer namelist_top_cfg 32 INTEGER, PUBLIC :: numonr = -1 !: logical unit for the reference passive tracer namelist output output.namelist.top 30 33 INTEGER, PUBLIC :: numstr !: logical unit for tracer statistics 31 34 INTEGER, PUBLIC :: numrtr !: logical unit for trc restart (read ) … … 68 71 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 69 72 REAL(wp) , PUBLIC :: rdttrc !: passive tracer time step 70 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 73 REAL(wp) , PUBLIC :: r2dttrc !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0 74 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 71 75 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 72 76 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 73 77 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas 74 INTEGER , PUBLIC :: nittrc000 78 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 75 79 LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP 76 80 … … 83 87 END TYPE 84 88 85 REAL(wp), DIMENSION(jptra), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio 86 trc_ice_prescr ! prescribed ice trc cc 87 CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 89 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_ratio ! ice-ocean tracer ratio 90 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trc_ice_prescr ! prescribed ice trc cc 91 CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc_o ! choice of ocean tracer cc 92 88 93 89 94 !! information for outputs … … 94 99 CHARACTER(len = 20) :: clunit !: unit 95 100 LOGICAL :: llinit !: read in a file or not 96 #if defined key_my_trc97 101 LOGICAL :: llsbc !: read in a file or not 98 102 LOGICAL :: llcbc !: read in a file or not 99 103 LOGICAL :: llobc !: read in a file or not 100 #endif101 LOGICAL :: llsave !: save the tracer or not102 104 END TYPE PTRACER 105 103 106 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcnm !: tracer name 104 107 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcln !: trccer field long name 105 108 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcun !: tracer unit 106 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_wri !: save the tracer or not107 109 108 110 TYPE, PUBLIC :: DIAG !: passive trcacer ddditional diagnostic type … … 112 114 END TYPE DIAG 113 115 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc3d !: 3D diagnostics for tracers 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc2d !: 2D diagnostics for tracers 118 114 119 !! information for inputs 115 120 !! -------------------------------------------------- 116 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file 117 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_obc !: Use open boundary condition data 118 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 119 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 120 121 !! additional 2D/3D outputs namelist 122 !! -------------------------------------------------- 123 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: trc2d !: additional 2d outputs array 124 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trc3d !: additional 3d outputs array 125 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc2d !: 2d field short name 126 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc2l !: 2d field long name 127 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc2u !: 2d field unit 128 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc3d !: 3d field short name 129 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc3l !: 3d field long name 130 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrc3u !: 3d field unit 131 LOGICAL , PUBLIC :: ln_diatrc !: boolean term for additional diagnostic 132 INTEGER , PUBLIC :: nn_writedia !: frequency of additional outputs 133 134 !! Biological trends 135 !! ----------------- 136 LOGICAL , PUBLIC :: ln_diabio !: boolean term for biological diagnostic 137 INTEGER , PUBLIC :: nn_writebio !: frequency of biological outputs 138 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trbio !: biological trends 139 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrbio !: bio field short name 140 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrbil !: bio field long name 141 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrbiu !: bio field unit 121 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file 122 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_obc !: Use open boundary condition data 123 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 124 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 125 LOGICAL , PUBLIC :: ln_rnf_ctl !: remove runoff dilution on tracers 126 REAL(wp), PUBLIC :: rn_bc_time !: Time scaling factor for SBC and CBC data (seconds in a day) 127 142 128 143 129 !! variables to average over physics over passive tracer sub-steps. … … 211 197 USE lib_mpp, ONLY: ctl_warn 212 198 !!------------------------------------------------------------------- 199 INTEGER :: ierr(3) 200 !!------------------------------------------------------------------- 201 ierr(:) = 0 213 202 ! 214 203 ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra), & … … 216 205 & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , & 217 206 & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , & 207 & trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , & 218 208 & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , & 219 & cvol(jpi,jpj,jpk) , trai(jptra) , & 220 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 221 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , & 222 #if defined key_my_trc 209 & cvol(jpi,jpj,jpk) , trai(jptra) , qsr_mean(jpi,jpj) , & 210 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 211 & ln_trc_ini(jptra) , & 223 212 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 224 #endif225 213 #if defined key_bdy 226 214 & cn_trc_dflt(nb_bdy) , cn_trc(nb_bdy) , nn_trcdmp_bdy(nb_bdy) , & 227 215 & trcdta_bdy(jptra,nb_bdy) , & 228 216 #endif 229 & STAT = trc_alloc ) 230 217 & STAT = ierr(1) ) 218 ! 219 IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(2) ) 220 ! 221 IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jpk,jp_dia2d), STAT = ierr(3) ) 222 ! 223 trc_alloc = MAXVAL( ierr ) 231 224 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') 232 225 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r6140 r7403 4 4 !! TOP : module for passive tracer boundary conditions 5 5 !!===================================================================== 6 !! History : 3.5 ! 2014-04 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015-03 (T . Lovato) Revision and BDY support 6 !! History : 3.5 ! 2014 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015 (T . Lovato) Revision and BDY support 8 !! 4.0 ! 2016 (T . Lovato) Include application of sbc and cbc 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP model 12 13 !!---------------------------------------------------------------------- 13 !! trc_bc : read and time interpolatedtracer Boundary Conditions14 !! trc_bc : Apply tracer Boundary Conditions 14 15 !!---------------------------------------------------------------------- 15 16 USE par_trc ! passive tracers parameters … … 26 27 PRIVATE 27 28 28 PUBLIC trc_bc _init ! called in trcini.F9029 PUBLIC trc_bc_ read ! called in trcstp.F90 or within29 PUBLIC trc_bc ! called in trcstp.F90 or within TOP modules 30 PUBLIC trc_bc_ini ! called in trcini.F90 30 31 31 32 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC … … 43 44 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 44 45 45 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 46 !! * Substitutions 47 # include "vectopt_loop_substitute.h90" 48 !!---------------------------------------------------------------------- 49 !! NEMO/TOP 4.0 , NEMO Consortium (2016) 47 50 !! $Id$ 48 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 50 53 CONTAINS 51 54 52 SUBROUTINE trc_bc_ini t( ntrc )55 SUBROUTINE trc_bc_ini( ntrc ) 53 56 !!---------------------------------------------------------------------- 54 !! *** ROUTINE trc_bc_ini t***57 !! *** ROUTINE trc_bc_ini *** 55 58 !! 56 59 !! ** Purpose : initialisation of passive tracer BC data … … 77 80 REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trcfac ! multiplicative factor for tracer values 78 81 !! 79 NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 82 NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, & 83 & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 80 84 #if defined key_bdy 81 85 NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 82 86 #endif 83 87 !!---------------------------------------------------------------------- 84 IF( nn_timing == 1 ) CALL timing_start('trc_bc_ini t')88 IF( nn_timing == 1 ) CALL timing_start('trc_bc_ini') 85 89 ! 86 90 IF( lwp ) THEN 87 91 WRITE(numout,*) ' ' 88 WRITE(numout,*) 'trc_bc_ini t: Tracers Boundary Conditions (BC)'92 WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 89 93 WRITE(numout,*) '~~~~~~~~~~~ ' 90 94 ENDIF … … 93 97 ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 94 98 IF( ierr0 > 0 ) THEN 95 CALL ctl_stop( 'trc_bc_ini t: unable to allocate local slf_i' ) ; RETURN99 CALL ctl_stop( 'trc_bc_ini: unable to allocate local slf_i' ) ; RETURN 96 100 ENDIF 97 101 … … 99 103 ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 ) 100 104 IF( ierr0 > 0 ) THEN 101 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indobc' ) ; RETURN105 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' ) ; RETURN 102 106 ENDIF 103 107 nb_trcobc = 0 … … 106 110 ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 ) 107 111 IF( ierr0 > 0 ) THEN 108 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indsbc' ) ; RETURN112 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' ) ; RETURN 109 113 ENDIF 110 114 nb_trcsbc = 0 … … 113 117 ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 ) 114 118 IF( ierr0 > 0 ) THEN 115 CALL ctl_stop( 'trc_bc_ini t: unable to allocate n_trc_indcbc' ) ; RETURN119 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' ) ; RETURN 116 120 ENDIF 117 121 nb_trccbc = 0 … … 140 144 DO jn = 1, ntrc 141 145 DO ib = 1, nb_bdy 142 ! Set type of obc in BDY data structure ( around here we may plug user override of obc type from nml)146 ! Set type of obc in BDY data structure (TL: around here we may plug user override of obc type from nml) 143 147 IF ( ln_trc_obc(jn) ) THEN 144 148 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) … … 195 199 ENDIF 196 200 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 197 201 IF ( .NOT. ln_rnf ) ln_rnf_ctl = .FALSE. 202 IF ( ln_rnf_ctl ) WRITE(numout,'(a)') ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 198 203 WRITE(numout,*) ' ' 199 204 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc … … 230 235 ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 231 236 IF( ierr1 > 0 ) THEN 232 CALL ctl_stop( 'trc_bc_ini t: unable to allocate sf_trcobc structure' ) ; RETURN237 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' ) ; RETURN 233 238 ENDIF 234 239 … … 248 253 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 249 254 IF( ierr2 + ierr3 > 0 ) THEN 250 CALL ctl_stop( 'trc_bc_ini t: unable to allocate passive tracer OBC data arrays' ) ; RETURN255 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' ) ; RETURN 251 256 ENDIF 252 257 trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) … … 270 275 ENDDO 271 276 272 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini t', 'Passive tracer OBC data', 'namtrc_bc' )277 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 273 278 ENDIF 274 279 #endif … … 277 282 ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 ) 278 283 IF( ierr1 > 0 ) THEN 279 CALL ctl_stop( 'trc_bc_ini t: unable to allocate sf_trcsbc structure' ) ; RETURN284 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcsbc structure' ) ; RETURN 280 285 ENDIF 281 286 ! … … 288 293 IF( sn_trcsbc(jn)%ln_tint ) ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 ) 289 294 IF( ierr2 + ierr3 > 0 ) THEN 290 CALL ctl_stop( 'trc_bc_ini t: unable to allocate passive tracer SBC data arrays' ) ; RETURN295 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer SBC data arrays' ) ; RETURN 291 296 ENDIF 292 297 ENDIF … … 294 299 ENDDO 295 300 ! ! fill sf_trcsbc with slf_i and control print 296 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini t', 'Passive tracer SBC data', 'namtrc_bc' )301 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) 297 302 ! 298 303 ENDIF … … 319 324 ENDDO 320 325 ! ! fill sf_trccbc with slf_i and control print 321 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini t', 'Passive tracer CBC data', 'namtrc_bc' )326 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) 322 327 ! 323 328 ENDIF 324 329 ! 325 330 DEALLOCATE( slf_i ) ! deallocate local field structure 326 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_ini t')327 ! 328 END SUBROUTINE trc_bc_ini t329 330 331 SUBROUTINE trc_bc _read(kt, jit)331 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_ini') 332 ! 333 END SUBROUTINE trc_bc_ini 334 335 336 SUBROUTINE trc_bc(kt, jit) 332 337 !!---------------------------------------------------------------------- 333 !! *** ROUTINE trc_bc _init***338 !! *** ROUTINE trc_bc *** 334 339 !! 335 !! ** Purpose : Read passive tracer Boundary Conditions data340 !! ** Purpose : Apply Boundary Conditions data to tracers 336 341 !! 337 !! ** Method : Read BC inputs and update data structures using fldread 342 !! ** Method : 1) Read BC inputs and update data structures using fldread 343 !! 2) Apply Boundary Conditions to tracers 338 344 !! 339 345 !!---------------------------------------------------------------------- … … 341 347 342 348 !! * Arguments 343 INTEGER, INTENT( in ) :: kt ! ocean time-step index349 INTEGER, INTENT( in ) :: kt ! ocean time-step index 344 350 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 351 !! 352 INTEGER :: ji, jj, jk, jn, jl ! Loop index 353 REAL(wp) :: zfact, zrnf 345 354 !!--------------------------------------------------------------------- 346 355 ! 347 IF( nn_timing == 1 ) CALL timing_start('trc_bc _read')356 IF( nn_timing == 1 ) CALL timing_start('trc_bc') 348 357 349 358 IF( kt == nit000 .AND. lwp) THEN 350 359 WRITE(numout,*) 351 WRITE(numout,*) 'trc_bc _read: Surface boundary conditions for passive tracers.'360 WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 352 361 WRITE(numout,*) '~~~~~~~~~~~ ' 353 362 ENDIF 354 363 364 ! 1. Update Boundary conditions data 355 365 IF ( PRESENT(jit) ) THEN 356 366 … … 395 405 ENDIF 396 406 397 ! 398 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_read') 399 ! 400 END SUBROUTINE trc_bc_read 407 ! 2. Apply Boundary conditions data 408 ! 409 DO jn = 1 , jptra 410 ! 411 ! Remove river dilution for tracers with absent river load 412 IF ( ln_rnf_ctl .AND. .NOT. ln_trc_cbc(jn) ) THEN 413 DO jj = 2, jpj 414 DO ji = fs_2, fs_jpim1 415 DO jk = 1, nk_rnf(ji,jj) 416 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 417 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (trn(ji,jj,jk,jn) * zrnf) 418 ENDDO 419 ENDDO 420 ENDDO 421 ENDIF 422 423 ! OPEN boundary conditions: trcbdy is called in trcnxt ! 424 425 ! SURFACE boundary conditions 426 IF (ln_trc_sbc(jn)) THEN 427 jl = n_trc_indsbc(jn) 428 DO jj = 2, jpj 429 DO ji = fs_2, fs_jpim1 ! vector opt. 430 zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 431 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 432 END DO 433 END DO 434 END IF 435 436 ! COASTAL boundary conditions 437 IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN 438 jl = n_trc_indcbc(jn) 439 DO jj = 2, jpj 440 DO ji = fs_2, fs_jpim1 ! vector opt. 441 DO jk = 1, nk_rnf(ji,jj) 442 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 443 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 444 ENDDO 445 END DO 446 END DO 447 END IF 448 ! ! =========== 449 END DO ! tracer loop 450 ! ! =========== 451 ! 452 IF( nn_timing == 1 ) CALL timing_stop('trc_bc') 453 ! 454 END SUBROUTINE trc_bc 401 455 402 456 #else … … 406 460 CONTAINS 407 461 408 SUBROUTINE trc_bc_ini t( ntrc ) ! Empty routine462 SUBROUTINE trc_bc_ini( ntrc ) ! Empty routine 409 463 INTEGER,INTENT(IN) :: ntrc ! number of tracers 410 WRITE(*,*) 'trc_bc_ini t: You should not have seen this print! error?', kt411 END SUBROUTINE trc_bc_ini t412 413 SUBROUTINE trc_bc _read( kt ) ! Empty routine414 WRITE(*,*) 'trc_bc _read: You should not have seen this print! error?', kt415 END SUBROUTINE trc_bc _read464 WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 465 END SUBROUTINE trc_bc_ini 466 467 SUBROUTINE trc_bc( kt ) ! Empty routine 468 WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 469 END SUBROUTINE trc_bc 416 470 #endif 417 471 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6701 r7403 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 11 !! 3.6 ! 2015-03 (T. Lovato) revisi on of code log info11 !! 3.6 ! 2015-03 (T. Lovato) revisit code I/O 12 12 !!---------------------------------------------------------------------- 13 13 #if defined key_top … … 28 28 29 29 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 30 PUBLIC trc_dta_ini t! called in trcini.F9030 PUBLIC trc_dta_ini ! called in trcini.F90 31 31 32 32 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data … … 45 45 CONTAINS 46 46 47 SUBROUTINE trc_dta_ini t(ntrc)48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini t***47 SUBROUTINE trc_dta_ini(ntrc) 48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini *** 50 50 !! 51 51 !! ** Purpose : initialisation of passive tracer input data … … 70 70 !!---------------------------------------------------------------------- 71 71 ! 72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini t')72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini') 73 73 ! 74 74 IF( lwp ) THEN 75 75 WRITE(numout,*) ' ' 76 WRITE(numout,*) ' trc_dta_ini t: Tracers Initial Conditions (IC)'76 WRITE(numout,*) ' trc_dta_ini : Tracers Initial Conditions (IC)' 77 77 WRITE(numout,*) ' ~~~~~~~~~~~ ' 78 78 ENDIF … … 83 83 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 84 84 IF( ierr0 > 0 ) THEN 85 CALL ctl_stop( 'trc_dta_ini t: unable to allocate n_trc_index' ) ; RETURN85 CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' ) ; RETURN 86 86 ENDIF 87 87 nb_trcdta = 0 … … 103 103 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 104 104 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin reference namelist', lwp )105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 106 106 107 107 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 108 108 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin configuration namelist', lwp )109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 110 110 IF(lwm) WRITE ( numont, namtrc_dta ) 111 111 … … 118 118 zfact = rn_trfac(jn) 119 119 IF( clndta /= clntrc ) THEN 120 CALL ctl_warn( 'trc_dta_ini t: passive tracer data initialisation ', &120 CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation ', & 121 121 & 'Input name of data file : '//TRIM(clndta)// & 122 122 & ' differs from that of tracer : '//TRIM(clntrc)//' ') … … 132 132 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 133 133 IF( ierr1 > 0 ) THEN 134 CALL ctl_stop( 'trc_dta_ini t: unable to allocate sf_trcdta structure' ) ; RETURN134 CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN 135 135 ENDIF 136 136 ! … … 143 143 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 144 144 IF( ierr2 + ierr3 > 0 ) THEN 145 CALL ctl_stop( 'trc_dta_ini t: unable to allocate passive tracer data arrays' ) ; RETURN145 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' ) ; RETURN 146 146 ENDIF 147 147 ENDIF … … 149 149 ENDDO 150 150 ! ! fill sf_trcdta with slf_i and control print 151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini t', 'Passive tracer data', 'namtrc' )151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' ) 152 152 ! 153 153 ENDIF 154 154 ! 155 155 DEALLOCATE( slf_i ) ! deallocate local field structure 156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini t')157 ! 158 END SUBROUTINE trc_dta_ini t159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini') 157 ! 158 END SUBROUTINE trc_dta_ini 159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_dta *** … … 169 169 !! - ln_trcdmp=F: deallocates the data structure as they are not used 170 170 !! 171 !! ** Action : sf_trcdta passive tracer data on me dlmesh and interpolated at time-step kt172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt! ocean time-step174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta! array of information on the field to read175 REAL(wp) , INTENT(in ) :: ptrfac! multiplication factor176 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc171 !! ** Action : sf_trcdta passive tracer data on meld mesh and interpolated at time-step kt 172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt ! ocean time-step 174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read 175 REAL(wp) , INTENT(in ) :: ztrcfac ! multiplication factor 176 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ztrcdta ! 3D data array 177 177 ! 178 178 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 179 179 REAL(wp):: zl, zi 180 180 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace182 181 CHARACTER(len=100) :: clndta 183 182 !!---------------------------------------------------------------------- … … 187 186 IF( nb_trcdta > 0 ) THEN 188 187 ! 189 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 190 ! 191 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 192 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 193 ! 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 188 ! read data at kt time step 189 CALL fld_read( kt, 1, sf_trcdta ) 190 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 191 ! 192 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 195 193 ! 196 194 IF( kt == nit000 .AND. lwp )THEN … … 205 203 ztp(jk) = ztrcdta(ji,jj,1) 206 204 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 207 ztp(jk) = 205 ztp(jk) = ztrcdta(ji,jj,jpkm1) 208 206 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 209 207 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 210 208 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 211 209 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 212 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 213 ztrcdta(ji,jj,jkk) ) * zi 210 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - ztrcdta(ji,jj,jkk) ) * zi 214 211 ENDIF 215 212 END DO … … 217 214 END DO 218 215 DO jk = 1, jpkm1 219 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord216 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 220 217 END DO 221 218 ztrcdta(ji,jj,jpk) = 0._wp … … 224 221 ! 225 222 ELSE !== z- or zps- coordinate ==! 226 ! 227 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level223 ! zps-coordinate (partial steps) interpolation at the last ocean level 224 IF( ln_zps ) THEN 228 225 DO jj = 1, jpj 229 226 DO ji = 1, jpi … … 244 241 ENDIF 245 242 ! 246 ! Add multiplicative factor 247 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 248 ! 249 ! Data structure for trc_ini (and BFMv5.1 coupling) 250 IF( .NOT. PRESENT(ptrc) ) sf_trcdta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 251 ! 252 ! Data structure for trc_dmp 253 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 254 ! 255 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 243 ! Scale by multiplicative factor 244 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ztrcfac 256 245 ! 257 246 ENDIF … … 266 255 !!---------------------------------------------------------------------- 267 256 CONTAINS 268 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) ! Empty routine257 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) ! Empty routine 269 258 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 270 259 END SUBROUTINE trc_dta -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcice.F90
r5385 r7403 17 17 USE trcice_cfc ! CFC initialisation 18 18 USE trcice_pisces ! PISCES initialisation 19 USE trcice_c14b ! C14 bomb initialisation 19 USE trcice_c14 ! C14 bomb initialisation 20 USE trcice_age ! aGE initialisation 20 21 USE trcice_my_trc ! MY_TRC initialisation 21 22 … … 45 46 46 47 IF( nn_timing == 1 ) CALL timing_start('trc_ice_ini') 47 48 ! 49 CALL trc_nam_ice 48 50 ! 49 51 trc_i(:,:,:) = 0.0d0 ! by default … … 51 53 52 54 IF ( nn_ice_tr == 1 ) THEN 53 IF( lk_pisces ) CALL trc_ice_ini_pisces ! PISCES bio-model 54 IF( lk_cfc ) CALL trc_ice_ini_cfc ! CFC tracers 55 IF( lk_c14b ) CALL trc_ice_ini_c14b ! C14 bomb tracer 56 IF( lk_my_trc ) CALL trc_ice_ini_my_trc ! MY_TRC tracers 55 IF( ln_pisces ) CALL trc_ice_ini_pisces ! PISCES bio-model 56 IF( ll_cfc ) CALL trc_ice_ini_cfc ! CFC tracers 57 IF( ln_c14 ) CALL trc_ice_ini_c14 ! C14 tracer 58 IF( ln_age ) CALL trc_ice_ini_age ! AGE tracer 59 IF( ln_my_trc ) CALL trc_ice_ini_my_trc ! MY_TRC tracers 57 60 ENDIF 58 61 … … 60 63 ! 61 64 END SUBROUTINE trc_ice_ini 65 66 SUBROUTINE trc_nam_ice 67 !!--------------------------------------------------------------------- 68 !! *** ROUTINE trc_nam_ice *** 69 !! 70 !! ** Purpose : Read the namelist for the ice effect on tracers 71 !! 72 !! ** Method : - 73 !! 74 !!--------------------------------------------------------------------- 75 INTEGER :: jn ! dummy loop indices 76 INTEGER :: ios, ierr ! Local integer output status for namelist read 77 ! 78 TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 79 !! 80 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 81 !!--------------------------------------------------------------------- 82 ! 83 IF(lwp) THEN 84 WRITE(numout,*) 85 WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 86 WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 87 ENDIF 88 89 IF( nn_timing == 1 ) CALL timing_start('trc_nam_ice') 90 91 ! 92 REWIND( numnat_ref ) ! Namelist namtrc_ice in reference namelist : Passive tracer input data 93 READ ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 94 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 95 96 REWIND( numnat_cfg ) ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 97 READ ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 98 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 99 100 IF( lwp ) THEN 101 WRITE(numout,*) ' ' 102 WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 103 WRITE(numout,*) ' ' 104 ENDIF 105 ! 106 ! Assign namelist stuff 107 DO jn = 1, jptra 108 trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio 109 trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 110 cn_trc_o (jn) = sn_tri_tracer(jn)%ctrc_o 111 END DO 112 113 IF( nn_timing == 1 ) CALL timing_stop('trc_nam_ice') 114 ! 115 END SUBROUTINE trc_nam_ice 62 116 63 117 #else … … 68 122 SUBROUTINE trc_ice_ini ! Dummy routine 69 123 END SUBROUTINE trc_ice_ini 124 125 SUBROUTINE trc_nam_ice 126 END SUBROUTINE trc_nam_ice 127 70 128 #endif 71 129 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6701 r7403 24 24 USE trcrst 25 25 USE lib_mpp ! distribued memory computing library 26 USE sbc_oce27 26 USE trcice ! tracers in sea ice 28 USE trcbc, only : trc_bc_ini t! generalized Boundary Conditions27 USE trcbc, only : trc_bc_ini ! generalized Boundary Conditions 29 28 30 29 IMPLICIT NONE … … 58 57 IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 59 58 IF(lwp) WRITE(numout,*) '~~~~~~~' 60 61 ! 59 ! 60 CALL trc_ini_ctl ! control 61 CALL trc_nam ! read passive tracers namelists 62 62 CALL top_alloc() ! allocate TOP arrays 63 63 ! 64 CALL trc_ini_ctl ! control 65 ! 66 CALL trc_nam ! read passive tracers namelists 64 IF(.NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE. 67 65 ! 68 66 IF(lwp) WRITE(numout,*) 69 !70 67 IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' ) ! calendar 71 !72 68 IF(lwp) WRITE(numout,*) 73 69 ! 74 70 CALL trc_ini_sms ! SMS 75 !71 CALL trc_ini_inv ! Inventories 76 72 CALL trc_ini_trp ! passive tracers transport 77 !78 73 CALL trc_ice_ini ! Tracers in sea ice 79 74 ! 80 IF( lwp ) & 81 & CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 75 IF(lwp) CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 82 76 ! 83 77 CALL trc_ini_state ! passive tracers initialisation : from a restart or from clim 84 ! 85 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 86 ! 87 CALL trc_ini_inv ! Inventories 78 IF( nn_dttrc /= 1 ) & 79 CALL trc_sub_ini ! Initialize variables for substepping passive tracers 88 80 ! 89 81 IF( nn_timing == 1 ) CALL timing_stop('trc_init') … … 120 112 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 121 113 END DO 122 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol123 114 ! ! total volume of the ocean 124 115 areatot = glob_sum( cvol(:,:,:) ) … … 131 122 IF(lwp) THEN ! control print 132 123 WRITE(numout,*) 133 WRITE(numout,*) 134 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 135 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 136 WRITE(numout,*) ' *** Total inital content of all tracers ' 124 WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 125 WRITE(numout,*) ' *** Total volume of ocean = ', areatot 126 WRITE(numout,*) ' *** Total inital content of all tracers ' 137 127 WRITE(numout,*) 138 128 DO jn = 1, jptra … … 148 138 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 149 139 ENDIF 150 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)140 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 151 141 ! 152 142 END SUBROUTINE trc_ini_inv … … 158 148 !! ** Purpose : SMS initialisation 159 149 !!---------------------------------------------------------------------- 160 USE trcini_cfc ! CFC initialisation 161 USE trcini_pisces ! PISCES initialisation 162 USE trcini_c14b ! C14 bomb initialisation 163 USE trcini_my_trc ! MY_TRC initialisation 164 !!---------------------------------------------------------------------- 165 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 166 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 167 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 168 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 150 USE trcini_pisces ! PISCES initialisation 151 USE trcini_cfc ! CFC initialisation 152 USE trcini_c14 ! C14 initialisation 153 USE trcini_age ! age initialisation 154 USE trcini_my_trc ! MY_TRC initialisation 155 ! 156 INTEGER :: jn 157 !!---------------------------------------------------------------------- 158 ! 159 ! Pass sn_tracer fields to specialized arrays 160 DO jn = 1, jp_bgc 161 ctrcnm (jn) = TRIM( sn_tracer(jn)%clsname ) 162 ctrcln (jn) = TRIM( sn_tracer(jn)%cllname ) 163 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 164 ln_trc_ini(jn) = sn_tracer(jn)%llinit 165 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc 166 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc 167 ln_trc_obc(jn) = sn_tracer(jn)%llobc 168 END DO 169 ! 170 IF( ln_pisces ) CALL trc_ini_pisces ! PISCES model 171 IF( ln_my_trc ) CALL trc_ini_my_trc ! MY_TRC model 172 IF( ll_cfc ) CALL trc_ini_cfc ! CFC's 173 IF( ln_c14 ) CALL trc_ini_c14 ! C14 model 174 IF( ln_age ) CALL trc_ini_age ! AGE 175 ! 176 IF(lwp) THEN ! control print 177 WRITE(numout,*) 178 WRITE(numout,*) ' trc_init: Summary for selected passive tracers' 179 WRITE(numout,*) ' ~~~~~~~~~~~~~~' 180 WRITE(numout,*) ' ID NAME INI SBC CBC OBC' 181 DO jn = 1, jptra 182 WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn) 183 END DO 184 ENDIF 185 9001 FORMAT(1x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 169 186 ! 170 187 END SUBROUTINE trc_ini_sms … … 207 224 ! 208 225 ! Initialisation of tracers Initial Conditions 209 IF( ln_trcdta ) CALL trc_dta_ini t(jptra)226 IF( ln_trcdta ) CALL trc_dta_ini(jptra) 210 227 211 228 ! Initialisation of tracers Boundary Conditions 212 IF( l k_my_trc ) CALL trc_bc_init(jptra)229 IF( ln_my_trc ) CALL trc_bc_ini(jptra) 213 230 214 231 IF( ln_rsttr ) THEN … … 217 234 ! 218 235 ELSE 219 ! 220 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping221 ! 236 ! Initialisation of tracer from a file that may also be used for damping 237 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 238 ! update passive tracers arrays with input data read from file 222 239 DO jn = 1, jptra 223 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file240 IF( ln_trc_ini(jn) ) THEN 224 241 jl = n_trc_index(jn) 225 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 226 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 242 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) ) 227 243 ! 228 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==!229 ! (data used only for initialisation)244 ! deallocate data structure if data are not used for damping 245 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 230 246 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 231 DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure247 DEALLOCATE( sf_trcdta(jl)%fnow ) 232 248 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 233 249 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r6140 r7403 20 20 USE oce_trc ! shared variables between ocean and passive tracers 21 21 USE trc ! passive tracers common variables 22 USE trcnam_pisces ! PISCES namelist23 USE trcnam_cfc ! CFC SMS namelist24 USE trcnam_c14b ! C14 SMS namelist25 USE trcnam_my_trc ! MY_TRC SMS namelist26 22 USE trd_oce 27 23 USE trdtrc_oce … … 34 30 PUBLIC trc_nam ! called in trcini 35 31 32 TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC :: sn_tracer ! type of tracer for saving if not key_iomput 33 36 34 !!---------------------------------------------------------------------- 37 35 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 52 50 !!--------------------------------------------------------------------- 53 51 INTEGER :: jn ! dummy loop indice 54 ! 55 IF( .NOT.lk_offline ) CALL trc_nam_run ! Parameters of the run 52 ! 53 IF( .NOT.lk_offline ) CALL trc_nam_run ! Parameters of the run 56 54 ! 57 55 CALL trc_nam_trc ! passive tracer informations 58 56 ! 59 CALL trc_nam_dia ! Parameters of additional diagnostics60 !61 !62 57 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 63 58 ! 64 59 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 65 60 ! 66 IF( .NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE.67 68 IF(lwp) THEN ! control print69 WRITE(numout,*)70 WRITE(numout,*) ' Namelist : namtrc'71 WRITE(numout,*) ' Read inputs data from file (y/n) ln_trcdta = ', ln_trcdta72 WRITE(numout,*) ' Damping of passive tracer (y/n) ln_trcdmp = ', ln_trcdmp73 WRITE(numout,*) ' Restoring of tracer on closed seas ln_trcdmp_clo = ', ln_trcdmp_clo74 WRITE(numout,*) ' '75 DO jn = 1, jptra76 WRITE(numout,*) ' tracer nb : ', jn, ' short name : ', ctrcnm(jn)77 END DO78 WRITE(numout,*) ' '79 ENDIF80 61 81 62 IF(lwp) THEN ! control print … … 96 77 ENDIF 97 78 ENDIF 98 99 100 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 101 102 IF(lwp) THEN ! control print 79 ! 80 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 81 ! 82 IF(lwp) THEN ! control print 103 83 WRITE(numout,*) 104 84 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc 105 85 WRITE(numout,*) 106 86 ENDIF 107 108 109 #if defined key_trdmxl_trc || defined key_trdtrc 110 111 REWIND( numnat_ref ) ! Namelist namtrc_trd in reference namelist : Passive tracer trends 112 READ ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 113 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 114 115 REWIND( numnat_cfg ) ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 116 READ ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 117 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 118 IF(lwm) WRITE ( numont, namtrc_trd ) 119 120 IF(lwp) THEN 121 WRITE(numout,*) 122 WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd ' 123 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 124 WRITE(numout,*) ' * frequency of trends diagnostics nn_trd_trc = ', nn_trd_trc 125 WRITE(numout,*) ' * control surface type nn_ctls_trc = ', nn_ctls_trc 126 WRITE(numout,*) ' * restart for ML diagnostics ln_trdmxl_trc_restart = ', ln_trdmxl_trc_restart 127 WRITE(numout,*) ' * flag to diagnose trends of ' 128 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant 129 WRITE(numout,*) ' * unit conversion factor rn_ucf_trc = ', rn_ucf_trc 130 DO jn = 1, jptra 131 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 132 END DO 133 ENDIF 134 #endif 135 136 137 ! Call the ice module for tracers 138 ! ------------------------------- 139 CALL trc_nam_ice 140 141 ! namelist of SMS 142 ! --------------- 143 IF( lk_pisces ) THEN ; CALL trc_nam_pisces ! PISCES bio-model 144 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 145 ENDIF 146 147 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers 148 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 149 ENDIF 150 151 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 152 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 153 ENDIF 154 155 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 156 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 157 ENDIF 87 ! 88 IF( l_trdtrc ) CALL trc_nam_trd ! Passive tracer trends 158 89 ! 159 90 END SUBROUTINE trc_nam … … 167 98 !! 168 99 !!--------------------------------------------------------------------- 169 NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc,ln_rsttr, nn_rsttr, ln_top_euler, &100 NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 170 101 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 171 102 ! … … 199 130 WRITE(numout,*) ' control of time step for passive tracer nn_rsttr = ', nn_rsttr 200 131 WRITE(numout,*) ' first time step for pass. trac. nittrc000 = ', nittrc000 201 WRITE(numout,*) ' frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc202 132 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 203 133 WRITE(numout,*) ' ' … … 206 136 END SUBROUTINE trc_nam_run 207 137 208 209 SUBROUTINE trc_nam_ice210 !!---------------------------------------------------------------------211 !! *** ROUTINE trc_nam_ice ***212 !!213 !! ** Purpose : Read the namelist for the ice effect on tracers214 !!215 !! ** Method : -216 !!217 !!---------------------------------------------------------------------218 INTEGER :: jn ! dummy loop indices219 INTEGER :: ios ! Local integer output status for namelist read220 !221 TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer222 !!223 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer224 !!---------------------------------------------------------------------225 !226 IF(lwp) THEN227 WRITE(numout,*)228 WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'229 WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'230 ENDIF231 232 IF( nn_timing == 1 ) CALL timing_start('trc_nam_ice')233 234 !235 REWIND( numnat_ref ) ! Namelist namtrc_ice in reference namelist : Passive tracer input data236 READ ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)237 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )238 239 REWIND( numnat_cfg ) ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients240 READ ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )241 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )242 243 IF( lwp ) THEN244 WRITE(numout,*) ' '245 WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr246 WRITE(numout,*) ' '247 ENDIF248 249 ! Assign namelist stuff250 DO jn = 1, jptra251 trc_ice_ratio(jn) = sn_tri_tracer(jn)%trc_ratio252 trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr253 cn_trc_o (jn) = sn_tri_tracer(jn)%ctrc_o254 END DO255 256 IF( nn_timing == 1 ) CALL timing_stop('trc_nam_ice')257 !258 END SUBROUTINE trc_nam_ice259 260 261 138 SUBROUTINE trc_nam_trc 262 139 !!--------------------------------------------------------------------- … … 266 143 !! 267 144 !!--------------------------------------------------------------------- 268 INTEGER :: ios ! Local integer output status for namelist read 269 INTEGER :: jn ! dummy loop indice 270 ! 271 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 272 !! 273 NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 274 !!--------------------------------------------------------------------- 145 INTEGER :: ios, ierr, icfc ! Local integer output status for namelist read 146 !! 147 NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 148 & sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 149 !!--------------------------------------------------------------------- 150 ! Dummy settings to fill tracers data structure 151 ! ! name ! title ! unit ! init ! sbc ! cbc ! obc ! 152 sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false.) 153 ! 275 154 IF(lwp) WRITE(numout,*) 276 155 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' … … 286 165 IF(lwm) WRITE ( numont, namtrc ) 287 166 288 DO jn = 1, jptra 289 ctrcnm (jn) = TRIM( sn_tracer(jn)%clsname ) 290 ctrcln (jn) = TRIM( sn_tracer(jn)%cllname ) 291 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 292 ln_trc_ini(jn) = sn_tracer(jn)%llinit 293 #if defined key_my_trc 294 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc 295 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc 296 ln_trc_obc(jn) = sn_tracer(jn)%llobc 297 #endif 298 ln_trc_wri(jn) = sn_tracer(jn)%llsave 299 END DO 300 ! 167 ! Control settings 168 IF( ln_pisces .AND. ln_my_trc ) CALL ctl_stop( 'Choose only ONE BGC model - PISCES or MY_TRC' ) 169 IF( .NOT. ln_pisces .AND. .NOT. ln_my_trc ) jp_bgc = 0 170 ll_cfc = ln_cfc11 .OR. ln_cfc12 .OR. ln_sf6 171 ! 172 jptra = 0 173 jp_pisces = 0 ; jp_pcs0 = 0 ; jp_pcs1 = 0 174 jp_my_trc = 0 ; jp_myt0 = 0 ; jp_myt1 = 0 175 jp_cfc = 0 ; jp_cfc0 = 0 ; jp_cfc1 = 0 176 jp_age = 0 ; jp_c14 = 0 177 ! 178 IF( ln_pisces ) THEN 179 jp_pisces = jp_bgc 180 jp_pcs0 = 1 181 jp_pcs1 = jp_pisces 182 ENDIF 183 IF( ln_my_trc ) THEN 184 jp_my_trc = jp_bgc 185 jp_myt0 = 1 186 jp_myt1 = jp_my_trc 187 ENDIF 188 ! 189 jptra = jp_bgc 190 ! 191 IF( ln_age ) THEN 192 jptra = jptra + 1 193 jp_age = jptra 194 ENDIF 195 IF( ln_cfc11 ) jp_cfc = jp_cfc + 1 196 IF( ln_cfc12 ) jp_cfc = jp_cfc + 1 197 IF( ln_sf6 ) jp_cfc = jp_cfc + 1 198 IF( ll_cfc ) THEN 199 jptra = jptra + jp_cfc 200 jp_cfc0 = jptra - jp_cfc + 1 201 jp_cfc1 = jptra 202 ENDIF 203 IF( ln_c14 ) THEN 204 jptra = jptra + 1 205 jp_c14 = jptra 206 ENDIF 207 ! 208 IF( jptra == 0 ) CALL ctl_stop( 'All TOP tracers disabled: change namtrc setting or check if key_top is active' ) 209 ! 210 IF(lwp) THEN ! control print 211 WRITE(numout,*) 212 WRITE(numout,*) ' Namelist : namtrc' 213 WRITE(numout,*) ' Total number of passive tracers jptra = ', jptra 214 WRITE(numout,*) ' Total number of BGC tracers jp_bgc = ', jp_bgc 215 WRITE(numout,*) ' Simulating PISCES model ln_pisces = ', ln_pisces 216 WRITE(numout,*) ' Simulating MY_TRC model ln_my_trc = ', ln_my_trc 217 WRITE(numout,*) ' Simulating water mass age ln_age = ', ln_age 218 WRITE(numout,*) ' Simulating CFC11 passive tracer ln_cfc11 = ', ln_cfc11 219 WRITE(numout,*) ' Simulating CFC12 passive tracer ln_cfc12 = ', ln_cfc12 220 WRITE(numout,*) ' Simulating SF6 passive tracer ln_sf6 = ', ln_sf6 221 WRITE(numout,*) ' Total number of CFCs tracers jp_cfc = ', jp_cfc 222 WRITE(numout,*) ' Simulating C14 passive tracer ln_c14 = ', ln_c14 223 WRITE(numout,*) ' Read inputs data from file (y/n) ln_trcdta = ', ln_trcdta 224 WRITE(numout,*) ' Damping of passive tracer (y/n) ln_trcdmp = ', ln_trcdmp 225 WRITE(numout,*) ' Restoring of tracer on closed seas ln_trcdmp_clo = ', ln_trcdmp_clo 226 WRITE(numout,*) ' ' 227 WRITE(numout,*) ' ' 228 ENDIF 229 ! 230 IF( ll_cfc .OR. ln_c14 ) THEN 231 ! ! Open namelist files 232 CALL ctl_opn( numtrc_ref, 'namelist_trc_ref' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 233 CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 234 IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 235 ! 236 ENDIF 237 301 238 END SUBROUTINE trc_nam_trc 302 239 303 304 SUBROUTINE trc_nam_dia 240 SUBROUTINE trc_nam_trd 305 241 !!--------------------------------------------------------------------- 306 242 !! *** ROUTINE trc_nam_dia *** … … 312 248 !! ( (PISCES, CFC, MY_TRC ) 313 249 !!--------------------------------------------------------------------- 250 251 #if defined key_trdmxl_trc || defined key_trdtrc 314 252 INTEGER :: ios ! Local integer output status for namelist read 315 253 INTEGER :: ierr 316 254 !! 317 #if defined key_trdmxl_trc || defined key_trdtrc318 255 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 319 256 & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 320 257 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 321 #endif322 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio323 258 !!--------------------------------------------------------------------- 324 259 325 260 IF(lwp) WRITE(numout,*) 326 IF(lwp) WRITE(numout,*) 'trc_nam_ dia: read the passive tracer diagnostics options'261 IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options' 327 262 IF(lwp) WRITE(numout,*) '~~~~~~~' 328 263 329 REWIND( numnat_ref ) ! Namelist namtrc_dia in reference namelist : Passive tracer diagnostics 330 READ ( numnat_ref, namtrc_dia, IOSTAT = ios, ERR = 903) 331 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in reference namelist', lwp ) 332 333 REWIND( numnat_cfg ) ! Namelist namtrc_dia in configuration namelist : Passive tracer diagnostics 334 READ ( numnat_cfg, namtrc_dia, IOSTAT = ios, ERR = 904 ) 335 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in configuration namelist', lwp ) 336 IF(lwm) WRITE ( numont, namtrc_dia ) 264 ! 265 ALLOCATE( ln_trdtrc(jptra) ) 266 ! 267 REWIND( numnat_ref ) ! Namelist namtrc_trd in reference namelist : Passive tracer trends 268 READ ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 269 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 270 271 REWIND( numnat_cfg ) ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 272 READ ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 273 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 274 IF(lwm) WRITE ( numont, namtrc_trd ) 337 275 338 276 IF(lwp) THEN 339 277 WRITE(numout,*) 340 WRITE(numout,*) 341 WRITE(numout,*) ' Namelist : namtrc_dia' 342 WRITE(numout,*) ' save additionnal diagnostics arrays ln_diatrc = ', ln_diatrc 343 WRITE(numout,*) ' save additionnal biology diagnostics arrays ln_diabio = ', ln_diabio 344 WRITE(numout,*) ' frequency of outputs for additional arrays nn_writedia = ', nn_writedia 345 WRITE(numout,*) ' frequency of outputs for biological trends nn_writebio = ', nn_writebio 346 WRITE(numout,*) ' ' 347 ENDIF 348 349 IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 350 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 351 & ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) , & 352 & ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) , STAT = ierr ) 353 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 354 ! 355 trc2d(:,:,: ) = 0._wp ; ctrc2d(:) = ' ' ; ctrc2l(:) = ' ' ; ctrc2u(:) = ' ' 356 trc3d(:,:,:,:) = 0._wp ; ctrc3d(:) = ' ' ; ctrc3l(:) = ' ' ; ctrc3u(:) = ' ' 357 ! 358 ENDIF 359 360 IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 361 ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 362 & ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr ) 363 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 364 ! 365 trbio(:,:,:,:) = 0._wp ; ctrbio(:) = ' ' ; ctrbil(:) = ' ' ; ctrbiu(:) = ' ' 366 ! 367 ENDIF 368 ! 369 END SUBROUTINE trc_nam_dia 278 WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd ' 279 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 280 WRITE(numout,*) ' * frequency of trends diagnostics nn_trd_trc = ', nn_trd_trc 281 WRITE(numout,*) ' * control surface type nn_ctls_trc = ', nn_ctls_trc 282 WRITE(numout,*) ' * restart for ML diagnostics ln_trdmxl_trc_restart = ', ln_trdmxl_trc_restart 283 WRITE(numout,*) ' * flag to diagnose trends of ' 284 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant 285 WRITE(numout,*) ' * unit conversion factor rn_ucf_trc = ', rn_ucf_trc 286 DO jn = 1, jptra 287 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 288 END DO 289 ENDIF 290 #endif 291 ! 292 END SUBROUTINE trc_nam_trd 370 293 371 294 #else -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r5656 r7403 16 16 USE trc ! 17 17 USE trcsms_pisces ! PISCES biogeo-model 18 USE trcsms_cfc ! CFC 11 & 12 19 USE trcsms_c14b ! C14b tracer 18 USE trcsms_cfc ! CFC 11 &/or 12 19 USE trcsms_c14 ! C14 20 USE trcsms_age ! AGE 20 21 USE trcsms_my_trc ! MY_TRC tracers 21 22 USE prtctl_trc ! Print control for debbuging … … 48 49 IF( nn_timing == 1 ) CALL timing_start('trc_sms') 49 50 ! 50 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 51 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 52 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 53 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 51 IF( ln_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 52 IF( ll_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 53 IF( ln_c14 ) CALL trc_sms_c14 ( kt ) ! surface fluxes of C14 54 IF( ln_age ) CALL trc_sms_age ( kt ) ! Age tracer 55 IF( ln_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 54 56 55 57 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6981 r7403 15 15 USE trctrp ! passive tracers transport 16 16 USE trcsms ! passive tracers sources and sinks 17 USE prtctl_trc ! Print control for debbuging18 USE trcdia19 17 USE trcwri 20 18 USE trcrst 21 19 USE trdtrc_oce 22 20 USE trdmxl_trc 21 USE prtctl_trc ! Print control for debbuging 23 22 USE iom 24 23 USE in_out_manager … … 62 61 IF( nn_timing == 1 ) CALL timing_start('trc_stp') 63 62 ! 63 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 64 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 65 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 66 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 67 ENDIF 68 ! 64 69 IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer 65 70 ! … … 68 73 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 69 74 END DO 70 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol71 75 areatot = glob_sum( cvol(:,:,:) ) 72 76 ENDIF … … 87 91 CALL trc_rst_opn ( kt ) ! Open tracer restart file 88 92 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 89 IF( lk_iomput ) THEN ; CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager 90 ELSE ; CALL trc_dia ( kt ) ! output of passive tracers with old I/O manager 91 ENDIF 93 CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager 92 94 CALL trc_sms ( kt ) ! tracers: sinks and sources 93 95 CALL trc_trp ( kt ) ! transport of passive tracers -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r5836 r7403 19 19 USE trcwri_pisces 20 20 USE trcwri_cfc 21 USE trcwri_c14b 21 USE trcwri_c14 22 USE trcwri_age 22 23 USE trcwri_my_trc 23 24 … … 53 54 ! write the tracer concentrations in the file 54 55 ! --------------------------------------- 55 IF( lk_pisces ) CALL trc_wri_pisces ! PISCES 56 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 57 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 58 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 56 IF( ln_pisces ) CALL trc_wri_pisces ! PISCES 57 IF( ll_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 58 IF( ln_c14 ) CALL trc_wri_c14 ! surface fluxes of C14 59 IF( ln_age ) CALL trc_wri_age ! AGE tracer 60 IF( ln_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 59 61 ! 60 62 IF( nn_timing == 1 ) CALL timing_stop('trc_wri') -
branches/2016/dev_merge_2016/NEMOGCM/SETTE/sette.sh
r6460 r7403 306 306 # set_namelist namelist_cfg nn_solv 2 307 307 set_namelist namelist_top_cfg ln_trcdta .false. 308 set_namelist namelist_top_cfg ln_diatrc .false.309 308 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 310 309 # if not you need input files, and for tests is not necessary … … 316 315 set_namelist namelist_pisces_cfg ln_ndepo .false. 317 316 set_namelist namelist_pisces_cfg ln_ironsed .false. 317 set_namelist namelist_pisces_cfg ln_ironice .false. 318 318 set_namelist namelist_pisces_cfg ln_hydrofe .false. 319 319 if [ ${USING_MPMD} == "yes" ] ; then … … 341 341 set_namelist namelist_cfg jpnij 8 342 342 # set_namelist namelist_cfg nn_solv 2 343 set_namelist namelist_top_cfg ln_diatrc .false.344 343 set_namelist namelist_top_cfg ln_rsttr .true. 345 344 set_namelist namelist_top_cfg nn_rsttr 2 … … 356 355 set_namelist namelist_pisces_cfg ln_ndepo .false. 357 356 set_namelist namelist_pisces_cfg ln_ironsed .false. 357 set_namelist namelist_pisces_cfg ln_ironice .false. 358 358 set_namelist namelist_pisces_cfg ln_hydrofe .false. 359 359 # put ln_pisdmp to false : no restoring to global mean value … … 400 400 # set_namelist namelist_cfg nn_solv 2 401 401 set_namelist namelist_top_cfg ln_trcdta .false. 402 set_namelist namelist_top_cfg ln_diatrc .false.403 402 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 404 403 # if not you need input files, and for tests is not necessary … … 410 409 set_namelist namelist_pisces_cfg ln_ndepo .false. 411 410 set_namelist namelist_pisces_cfg ln_ironsed .false. 411 set_namelist namelist_pisces_cfg ln_ironice .false. 412 412 set_namelist namelist_pisces_cfg ln_hydrofe .false. 413 413 # put ln_pisdmp to false : no restoring to global mean value … … 439 439 # set_namelist namelist_cfg nn_solv 2 440 440 set_namelist namelist_top_cfg ln_trcdta .false. 441 set_namelist namelist_top_cfg ln_diatrc .false.442 441 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 443 442 # if not you need input files, and for tests is not necessary … … 449 448 set_namelist namelist_pisces_cfg ln_ndepo .false. 450 449 set_namelist namelist_pisces_cfg ln_ironsed .false. 450 set_namelist namelist_pisces_cfg ln_ironice .false. 451 451 set_namelist namelist_pisces_cfg ln_hydrofe .false. 452 452 # put ln_pisdmp to false : no restoring to global mean value … … 486 486 set_namelist namelist_cfg jpnij 8 487 487 set_namelist namelist_top_cfg ln_trcdta .false. 488 set_namelist namelist_top_cfg ln_diatrc .false.489 488 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 490 489 # if not you need input files, and for tests is not necessary … … 496 495 set_namelist namelist_pisces_cfg ln_ndepo .false. 497 496 set_namelist namelist_pisces_cfg ln_ironsed .false. 497 set_namelist namelist_pisces_cfg ln_ironice .false. 498 498 set_namelist namelist_pisces_cfg ln_hydrofe .false. 499 499 # put ln_pisdmp to false : no restoring to global mean value … … 519 519 set_namelist namelist_cfg jpnj 4 520 520 set_namelist namelist_cfg jpnij 8 521 set_namelist namelist_top_cfg ln_diatrc .false.522 521 set_namelist namelist_top_cfg ln_rsttr .true. 523 522 set_namelist namelist_top_cfg nn_rsttr 2 … … 537 536 set_namelist namelist_pisces_cfg ln_ndepo .false. 538 537 set_namelist namelist_pisces_cfg ln_ironsed .false. 538 set_namelist namelist_pisces_cfg ln_ironice .false. 539 539 set_namelist namelist_pisces_cfg ln_hydrofe .false. 540 540 # put ln_pisdmp to false : no restoring to global mean value … … 572 572 set_namelist namelist_cfg jpnij 16 573 573 set_namelist namelist_top_cfg ln_trcdta .false. 574 set_namelist namelist_top_cfg ln_diatrc .false.575 574 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 576 575 # if not you need input files, and for tests is not necessary … … 582 581 set_namelist namelist_pisces_cfg ln_ndepo .false. 583 582 set_namelist namelist_pisces_cfg ln_ironsed .false. 583 set_namelist namelist_pisces_cfg ln_ironice .false. 584 584 set_namelist namelist_pisces_cfg ln_hydrofe .false. 585 585 # put ln_pisdmp to false : no restoring to global mean value … … 610 610 set_namelist namelist_cfg jpnij 16 611 611 set_namelist namelist_top_cfg ln_trcdta .false. 612 set_namelist namelist_top_cfg ln_diatrc .false.613 612 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 614 613 # if not you need input files, and for tests is not necessary … … 620 619 set_namelist namelist_pisces_cfg ln_ndepo .false. 621 620 set_namelist namelist_pisces_cfg ln_ironsed .false. 621 set_namelist namelist_pisces_cfg ln_ironice .false. 622 622 set_namelist namelist_pisces_cfg ln_hydrofe .false. 623 623 # put ln_pisdmp to false : no restoring to global mean value
Note: See TracChangeset
for help on using the changeset viewer.