Changeset 9169
- Timestamp:
- 2017-12-26T17:32:56+01:00 (7 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM
- Files:
-
- 108 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r9019 r9169 39 39 nn_bathy = 0 ! compute (=0) or read (=1) the bathymetry file 40 40 rn_bathy = 4198. ! value of the bathymetry. if (=0) bottom flat at jpkm1 41 nn_msh = 0 ! create (=1) a mesh file or not (=0)41 ! 42 42 rn_rdt = 360. ! time step for the dynamics 43 43 ppglam0 = -150.0 ! longitude of first raw and column T-point (jphgr_msh = 1) -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r9019 r9169 37 37 !----------------------------------------------------------------------- 38 38 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 39 !40 nn_msh = 0 ! create (>0) a mesh file or not (=0)41 39 ! 42 40 rn_rdt = 7200. ! time step for the dynamics (and tracer if nn_acc=0) -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r9019 r9169 37 37 !----------------------------------------------------------------------- 38 38 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 39 nn_msh = 0 ! create (>0) a mesh file or not (=0)39 ! 40 40 rn_rdt = 7200. ! time step for the dynamics (and tracer if nn_acc=0) 41 41 / -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg
r9063 r9169 23 23 !----------------------------------------------------------------------- 24 24 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 25 nn_closea = 0 ! remove (=0) or keep (=1) closed seas and lakes (ORCA)26 25 ! 27 26 rn_rdt = 2880. ! time step for the dynamics (and tracer if nn_acc=0) 28 !29 27 / 30 28 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
r9061 r9169 21 21 !----------------------------------------------------------------------- 22 22 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 23 !24 nn_msh = 0 ! create (>0) a mesh file or not (=0)25 !26 23 / 27 24 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/README
r7732 r9169 19 19 wget --recursive -l2 --no-directories --no-parent -A.nc -erobots=off http://dodsp.idris.fr/reee512/NEMO_OUT/ORCA2_LIM/ 20 20 21 You will aslo need the meshmask file (set nn_msh = 1 or nn_msh = 7in your namelist and run the model for at least 1 time step).21 You will aslo need the meshmask file (set ln_meshmask = TRUE in your namelist and run the model for at least 1 time step). 22 22 23 23 #---------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg
r9019 r9169 22 22 !----------------------------------------------------------------------- 23 23 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 24 !25 nn_msh = 0 ! create (>0) a mesh file or not (=0)26 !27 24 / 28 25 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/SHARED/namelist_ref
r9168 r9169 92 92 !----------------------------------------------------------------------- 93 93 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 94 nn_msh = 0 ! create (>0) a mesh file or not (=0) 95 rn_isfhmin = 1.00 ! treshold (m) to discriminate grounding ice to floating ice 94 rn_isfhmin = 1.00 ! treshold [m] to discriminate grounding ice from floating ice 96 95 ! 97 96 rn_rdt = 5760. ! time step for the dynamics and tracer … … 99 98 ! 100 99 ln_crs = .false. ! Logical switch for coarsening module (T => fill namcrs) 100 ! 101 ln_meshmask = .false. ! =T create a mesh file 101 102 / 102 103 !----------------------------------------------------------------------- … … 134 135 ! 1, coarse grid is binned with centering at the equator 135 136 ! Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty. 136 nn_msh_crs = 1 ! create (=1) a mesh file or not (=0)137 ln_msh_crs = .false. ! =T create a mesh & mask file 137 138 nn_crs_kz = 0 ! 0, MEAN of volume boxes 138 139 ! 1, MAX of boxes -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg
r9135 r9169 40 40 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 41 41 ! 42 nn_msh = 0 ! create (>0) a mesh file or not (=0)43 !44 42 rn_rdt = 1800. ! time step for the dynamics (and tracer if nn_acc=0) 43 ! 44 ln_meshmask = .false. ! =T create a mesh file 45 45 / 46 46 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg
r9019 r9169 32 32 !----------------------------------------------------------------------- 33 33 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 34 nn_closea = 1 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 35 ! 36 nn_msh = 1 ! create (>0) a mesh file or not (=0) 34 ! 37 35 rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice 38 36 ! … … 41 39 ! 42 40 ln_crs = .false. ! Logical switch for coarsening module 41 ! 42 ln_meshmask = .false. ! =T create a mesh file 43 43 / 44 44 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg
r9060 r9169 29 29 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 30 30 ! 31 nn_msh = 1 ! create (>0) a mesh file or not (=0)32 !33 31 rn_rdt = 400. ! time step for the dynamics (and tracer if nn_acc=0) 32 ! 33 ln_meshmask = .true. ! =T create a mesh file 34 34 / 35 35 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg
r9019 r9169 29 29 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 30 30 ! 31 nn_msh = 1 ! create (>0) a mesh file or not (=0)32 !33 31 rn_rdt = 1200. ! time step for the dynamics (and tracer if nn_acc=0) 32 ! 33 ln_meshmask = .true. ! =T create a mesh file 34 34 / 35 35 !----------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg
r9024 r9169 15 15 cn_exp = "WAD" ! experience name 16 16 nn_it000 = 1 ! first time step 17 nn_itend = 18 !nn_itend = 6! last time step17 nn_itend = 3840 ! last time step 18 !nn_itend = 6 ! last time step 19 19 nn_leapy = 30 ! Leap year calendar (1) or not (0) 20 20 nn_stock = 48000 ! frequency of creation of a restart file (modulo referenced to 1) … … 36 36 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 37 37 ! 38 nn_msh = 1! create (>0) a mesh file or not (=0)38 ln_meshmask = .true. ! create (>0) a mesh file or not (=0) 39 39 rn_rdt = 18. ! time step for the dynamics 40 40 / -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90
r9168 r9169 30 30 USE trc_oce ! shared ocean & passive tracers variab 31 31 USE phycst ! physical constants 32 USE usrdef_closea! closed seas32 USE closea ! closed seas 33 33 USE domhgr ! domain: set the horizontal mesh 34 34 USE domzgr ! domain: set the vertical mesh … … 37 37 USE domvvl ! variable volume 38 38 USE c1d ! 1D configuration 39 USE domc1d ! 1D configuration: column location40 39 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) 41 40 USE wet_dry ! wetting and drying … … 71 70 !! and scale factors, and the coriolis factor 72 71 !! - dom_zgr: define the vertical coordinate and the bathymetry 73 !! - dom_wri: create the meshmask file if nn_msh=172 !! - dom_wri: create the meshmask file (ln_meshmask=T) 74 73 !! - 1D configuration, move Coriolis, u and v at T-point 75 74 !!---------------------------------------------------------------------- … … 94 93 WRITE(numout,cform) ' ' ,' jpij : ', jpij 95 94 WRITE(numout,*) ' mpp local domain info (mpp):' 96 WRITE(numout,*) ' jpni : ', jpni, ' jpreci : ', jpreci97 WRITE(numout,*) ' jpnj : ', jpnj, ' jprecj : ', jprecj95 WRITE(numout,*) ' jpni : ', jpni, ' nn_hls : ', nn_hls 96 WRITE(numout,*) ' jpnj : ', jpnj, ' nn_hls : ', nn_hls 98 97 WRITE(numout,*) ' jpnij : ', jpnij 99 98 WRITE(numout,*) ' lateral boundary of the Global domain : jperio = ', jperio … … 106 105 CASE( 5 ) ; WRITE(numout,*) ' (i.e. north fold with F-point pivot)' 107 106 CASE( 6 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with F-point pivot)' 108 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic north-south (jpnij=1 only))'107 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)' 109 108 CASE DEFAULT 110 109 CALL ctl_stop( 'jperio is out of range' ) 111 110 END SELECT 112 111 WRITE(numout,*) ' Ocean model configuration used:' 113 WRITE(numout,*) ' cn_cfg = ', cn_cfg 114 WRITE(numout,*) ' nn_cfg = ', nn_cfg 115 ENDIF 116 ! 117 ! 118 !!gm This should be removed with the new configuration interface 119 IF( lk_c1d .AND. ln_c1d_locpt ) CALL dom_c1d( rn_lat1d, rn_lon1d ) 120 !!gm end 112 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 113 ENDIF 121 114 ! 122 115 ! !== Reference coordinate system ==! … … 124 117 CALL dom_glo ! global domain versus local domain 125 118 CALL dom_nam ! read namelist ( namrun, namdom ) 126 CALL dom_clo( cn_cfg, nn_cfg ) ! Closed seas and lake127 119 CALL dom_hgr ! Horizontal mesh 128 120 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry 129 IF( nn_closea == 0 ) CALL clo_bat( ik_top, ik_bot ) !== remove closed seas or lakes ==!130 121 CALL dom_msk( ik_top, ik_bot ) ! Masks 122 IF( ln_closea ) CALL dom_clo ! ln_closea=T : closed seas included in the simulation 123 ! Read in masks to define closed seas and lakes 131 124 ! 132 125 DO jj = 1, jpj ! depth of the iceshelves … … 182 175 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 183 176 ! 184 IF( nn_msh > 0 .AND. .NOT. ln_iscpl ) CALL dom_wri ! Create a domain file 185 IF( nn_msh > 0 .AND. ln_iscpl .AND. .NOT. ln_rstart ) CALL dom_wri ! Create a domain file 186 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 187 ! 188 177 IF( ln_meshmask .AND. .NOT.ln_iscpl ) CALL dom_wri ! Create a domain file 178 IF( ln_meshmask .AND. ln_iscpl .AND. .NOT.ln_rstart ) CALL dom_wri ! Create a domain file 179 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 180 ! 181 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file 182 ! 189 183 IF(lwp) THEN 190 184 WRITE(numout,*) 191 WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh 185 WRITE(numout,*) 'dom_init : ==>>> END of domain initialization' 186 WRITE(numout,*) '~~~~~~~~' 192 187 WRITE(numout,*) 193 188 ENDIF 194 !195 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file196 189 ! 197 190 END SUBROUTINE dom_init … … 240 233 IF( nn_print >= 1 ) THEN 241 234 WRITE(numout,*) 242 WRITE(numout,*) ' conversion local ==> global i-index domain '235 WRITE(numout,*) ' conversion local ==> global i-index domain (mig)' 243 236 WRITE(numout,25) (mig(ji),ji = 1,jpi) 244 237 WRITE(numout,*) 245 238 WRITE(numout,*) ' conversion global ==> local i-index domain' 246 WRITE(numout,*) ' starting index '239 WRITE(numout,*) ' starting index (mi0)' 247 240 WRITE(numout,25) (mi0(ji),ji = 1,jpiglo) 248 WRITE(numout,*) ' ending index '241 WRITE(numout,*) ' ending index (mi1)' 249 242 WRITE(numout,25) (mi1(ji),ji = 1,jpiglo) 250 243 WRITE(numout,*) 251 WRITE(numout,*) ' conversion local ==> global j-index domain '244 WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)' 252 245 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 253 246 WRITE(numout,*) 254 247 WRITE(numout,*) ' conversion global ==> local j-index domain' 255 WRITE(numout,*) ' starting index '248 WRITE(numout,*) ' starting index (mj0)' 256 249 WRITE(numout,25) (mj0(jj),jj = 1,jpjglo) 257 WRITE(numout,*) ' ending index '250 WRITE(numout,*) ' ending index (mj1)' 258 251 WRITE(numout,25) (mj1(jj),jj = 1,jpjglo) 259 252 ENDIF … … 275 268 !!---------------------------------------------------------------------- 276 269 USE ioipsl 270 !! 271 INTEGER :: ios ! Local integer 272 ! 277 273 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 278 274 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & … … 280 276 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , & 281 277 & ln_cfmeta, ln_iscpl 282 NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs278 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask 283 279 #if defined key_netcdf4 284 280 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 285 281 #endif 286 INTEGER :: ios ! Local integer output status for namelist read 287 !!---------------------------------------------------------------------- 282 !!---------------------------------------------------------------------- 283 ! 284 IF(lwp) THEN 285 WRITE(numout,*) 286 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 287 WRITE(numout,*) '~~~~~~~ ' 288 ENDIF 288 289 ! 289 290 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 290 291 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 291 292 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 292 !293 293 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 294 294 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) … … 297 297 ! 298 298 IF(lwp) THEN ! control print 299 WRITE(numout,*) 300 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 301 WRITE(numout,*) '~~~~~~~ ' 302 WRITE(numout,*) ' Namelist namrun' 303 WRITE(numout,*) ' job number nn_no = ', nn_no 304 WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp 305 WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in 306 WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir 307 WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out 308 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir 309 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 310 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 311 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 312 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 313 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 314 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 315 WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0 316 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 317 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 299 WRITE(numout,*) ' Namelist : namrun' 300 WRITE(numout,*) ' job number nn_no = ', nn_no 301 WRITE(numout,*) ' experiment name for output cn_exp = ', TRIM( cn_exp ) 302 WRITE(numout,*) ' file prefix restart input cn_ocerst_in = ', TRIM( cn_ocerst_in ) 303 WRITE(numout,*) ' restart input directory cn_ocerst_indir = ', TRIM( cn_ocerst_indir ) 304 WRITE(numout,*) ' file prefix restart output cn_ocerst_out = ', TRIM( cn_ocerst_out ) 305 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 306 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 307 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 308 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 309 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 310 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 311 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 312 WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0 313 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 314 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 318 315 IF( ln_rst_list ) THEN 319 WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist316 WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist 320 317 ELSE 321 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock318 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 322 319 ENDIF 323 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write324 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland325 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta326 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber327 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz328 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl320 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 321 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 322 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta 323 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 324 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 325 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl 329 326 ENDIF 330 327 … … 341 338 nwrite = nn_write 342 339 neuler = nn_euler 343 IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 344 WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 345 CALL ctl_warn( ctmp1 ) 340 IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 341 IF(lwp) WRITE(numout,*) 342 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 343 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0 ' 346 344 neuler = 0 347 345 ENDIF 348 346 ! ! control of output frequency 349 IF 347 IF( nstock == 0 .OR. nstock > nitend ) THEN 350 348 WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 351 349 CALL ctl_warn( ctmp1 ) … … 379 377 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 380 378 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 381 !382 379 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 383 380 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 384 381 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 385 IF(lwm) WRITE 382 IF(lwm) WRITE( numond, namdom ) 386 383 ! 387 384 IF(lwp) THEN 388 385 WRITE(numout,*) 389 WRITE(numout,*) ' Namelist namdom : space & time domain' 390 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 391 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 392 WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh 393 WRITE(numout,*) ' = 0 no file created ' 394 WRITE(numout,*) ' = 1 mesh_mask ' 395 WRITE(numout,*) ' = 2 mesh and mask ' 396 WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask' 397 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' (m)' 398 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 399 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 400 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 401 ENDIF 402 403 call flush( numout ) 404 ! 405 ! ! ! conversion DOCTOR names into model names (this should disappear soon) 406 atfp = rn_atfp 407 rdt = rn_rdt 386 WRITE(numout,*) ' Namelist : namdom --- space & time domain' 387 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 388 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 389 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]' 390 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 391 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 392 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 393 ENDIF 394 ! 395 ! ! conversion DOCTOR names into model names (this should disappear soon) 396 atfp = rn_atfp 397 rdt = rn_rdt 408 398 409 399 #if defined key_netcdf4 … … 412 402 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 413 403 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 414 !415 404 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 416 405 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) … … 421 410 WRITE(numout,*) 422 411 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters' 423 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i= ', nn_nchunks_i424 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j= ', nn_nchunks_j425 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k= ', nn_nchunks_k426 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip= ', ln_nc4zip412 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 413 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j 414 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k 415 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 427 416 ENDIF 428 417 … … 586 575 ! ! ============================= ! 587 576 ! 588 clnam = 'domcfg_out'! filename (configuration information)577 clnam = cn_domcfg_out ! filename (configuration information) 589 578 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 590 579 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90
r9124 r9169 193 193 REWIND( numnam_ice_ref ) ! Namelist namalb in reference namelist : Albedo parameters 194 194 READ ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 195 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 196 195 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 197 196 REWIND( numnam_ice_cfg ) ! Namelist namalb in configuration namelist : Albedo parameters 198 197 READ ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 199 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp )200 IF(lwm) WRITE 198 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp ) 199 IF(lwm) WRITE( numoni, namalb ) 201 200 ! 202 201 IF(lwp) THEN ! Control print -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90
r9124 r9169 180 180 REWIND( numnam_ice_ref ) ! Namelist namdia in reference namelist : Parameters for ice 181 181 READ ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 183 182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 184 183 REWIND( numnam_ice_cfg ) ! Namelist namdia in configuration namelist : Parameters for ice 185 184 READ ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 186 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp )185 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp ) 187 186 IF(lwm) WRITE ( numoni, namdia ) 188 187 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90
r9124 r9169 219 219 REWIND( numnam_ice_ref ) ! Namelist namdyn in reference namelist : Ice dynamics 220 220 READ ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 221 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 222 ! 221 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 223 222 REWIND( numnam_ice_cfg ) ! Namelist namdyn in configuration namelist : Ice dynamics 224 223 READ ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 225 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp )226 IF(lwm) WRITE 224 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp ) 225 IF(lwm) WRITE( numoni, namdyn ) 227 226 ! 228 227 IF(lwp) THEN ! control print … … 234 233 WRITE(numout,*) ' No ridge/raft & No cor (rhg + adv) ln_dynRHGADV = ', ln_dynRHGADV 235 234 WRITE(numout,*) ' Advection only (rn_uvice + adv) ln_dynADV = ', ln_dynADV 236 WRITE(numout,*) ' with prescribed velocity given by ' 237 WRITE(numout,*) ' a uniform field (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 235 WRITE(numout,*) ' with prescribed velocity given by (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 238 236 WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat 239 237 WRITE(numout,*) ' Landfast: param (T or F) ln_landfast = ', ln_landfast … … 241 239 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr 242 240 WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax 241 WRITE(numout,*) 243 242 ENDIF 244 243 ! !== set the choice of ice dynamics ==! … … 260 259 ENDIF 261 260 ! !--- NO Landfast ice : set to zero once for all 262 IF( .NOT. 261 IF( .NOT.ln_landfast ) tau_icebfr(:,:) = 0._wp 263 262 ! 264 263 CALL ice_dyn_rdgrft_init ! set ice ridging/rafting parameters -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90
r9124 r9169 138 138 REWIND( numnam_ice_ref ) ! Namelist namdyn_adv in reference namelist : Ice dynamics 139 139 READ ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 140 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 141 ! 140 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 142 141 REWIND( numnam_ice_cfg ) ! Namelist namdyn_adv in configuration namelist : Ice dynamics 143 142 READ ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 144 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )145 IF(lwm) WRITE 143 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 144 IF(lwm) WRITE( numoni, namdyn_adv ) 146 145 ! 147 146 IF(lwp) THEN ! control print -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90
r9124 r9169 891 891 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 892 892 READ ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 893 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 894 ! 893 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 895 894 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 896 895 READ ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 897 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp )896 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 898 897 IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 899 898 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90
r9124 r9169 114 114 READ ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 115 115 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp ) 116 !117 116 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 118 117 READ ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) … … 124 123 WRITE(numout,*) 'ice_dyn_rhg_init: ice parameters for ice dynamics ' 125 124 WRITE(numout,*) '~~~~~~~~~~~~~~~' 126 WRITE(numout,*) ' Namelist namdyn_rhg:'125 WRITE(numout,*) ' Namelist : namdyn_rhg:' 127 126 WRITE(numout,*) ' rheology EVP (icedyn_rhg_evp) ln_rhg_EVP = ', ln_rhg_EVP 128 127 WRITE(numout,*) ' use adaptive EVP (aEVP) ln_aEVP = ', ln_aEVP -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90
r9049 r9169 875 875 CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 876 876 ELSE ! start rheology from rest 877 IF(lwp) WRITE(numout,*) ' ==>> previous run without rheology, set stresses to 0' 877 IF(lwp) WRITE(numout,*) 878 IF(lwp) WRITE(numout,*) ' ==>>> previous run without rheology, set stresses to 0' 878 879 stress1_i (:,:) = 0._wp 879 880 stress2_i (:,:) = 0._wp … … 881 882 ENDIF 882 883 ELSE !* Start from rest 883 IF(lwp) WRITE(numout,*) ' ==>> start from rest: set stresses to 0' 884 IF(lwp) WRITE(numout,*) 885 IF(lwp) WRITE(numout,*) ' ==>>> start from rest: set stresses to 0' 884 886 stress1_i (:,:) = 0._wp 885 887 stress2_i (:,:) = 0._wp -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90
r9124 r9169 52 52 !! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 53 53 !!------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt ! ocean time step 55 INTEGER, INTENT(in) :: ksbc ! type of sbc flux ( 1 = user defined formulation, 56 ! 3 = bulk formulation, 57 ! 4 = Pure Coupled formulation) 58 REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: utau_ice, vtau_ice 54 INTEGER , INTENT(in ) :: kt ! ocean time step 55 INTEGER , INTENT(in ) :: ksbc ! type of sbc flux 56 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: utau_ice, vtau_ice ! air-ice stress [N/m2] 59 57 !! 60 58 INTEGER :: ji, jj ! dummy loop index 61 59 REAL(wp), DIMENSION(jpi,jpj) :: zutau_ice, zvtau_ice 62 60 !!------------------------------------------------------------------- 63 61 ! 64 62 IF( ln_timing ) CALL timing_start('ice_forcing') 65 63 ! 66 64 IF( kt == nit000 .AND. lwp ) THEN 67 65 WRITE(numout,*) … … 69 67 WRITE(numout,*)'~~~~~~~~~~~~~~~' 70 68 ENDIF 71 69 ! 72 70 SELECT CASE( ksbc ) 73 71 CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation … … 75 73 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 76 74 END SELECT 77 75 ! 78 76 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 79 77 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) … … 86 84 CALL lbc_lnk_multi( utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 87 85 ENDIF 88 86 ! 89 87 IF( ln_timing ) CALL timing_stop('ice_forcing') 90 88 ! … … 255 253 END SUBROUTINE ice_flx_dist 256 254 255 257 256 SUBROUTINE ice_forcing_init 258 257 !!------------------------------------------------------------------- 259 258 !! *** ROUTINE ice_forcing_init *** 260 259 !! 261 !! ** Purpose : Physical constants and parameters linked to the ice 262 !! dynamics 263 !! 264 !! ** Method : Read the namforcing namelist and check the ice-dynamic 265 !! parameter values called at the first timestep (nit000) 260 !! ** Purpose : Physical constants and parameters linked to the ice dynamics 261 !! 262 !! ** Method : Read the namforcing namelist and check the ice-dynamic 263 !! parameter values called at the first timestep (nit000) 266 264 !! 267 265 !! ** input : Namelist namforcing 268 266 !!------------------------------------------------------------------- 269 INTEGER :: ios, ioptio ! Local integer output status for namelist read267 INTEGER :: ios, ioptio ! Local integer 270 268 !! 271 269 NAMELIST/namforcing/ rn_cio, rn_blow_s, nn_flxdist, nice_jules … … 274 272 REWIND( numnam_ice_ref ) ! Namelist namforcing in reference namelist : Ice dynamics 275 273 READ ( numnam_ice_ref, namforcing, IOSTAT = ios, ERR = 901) 276 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in reference namelist', lwp ) 277 ! 274 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in reference namelist', lwp ) 278 275 REWIND( numnam_ice_cfg ) ! Namelist namforcing in configuration namelist : Ice dynamics 279 276 READ ( numnam_ice_cfg, namforcing, IOSTAT = ios, ERR = 902 ) 280 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namforcing in configuration namelist', lwp )281 IF(lwm) WRITE 277 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namforcing in configuration namelist', lwp ) 278 IF(lwm) WRITE( numoni, namforcing ) 282 279 ! 283 280 IF(lwp) THEN ! control print 284 281 WRITE(numout,*) 285 282 WRITE(numout,*) 'ice_forcing_init: ice parameters for ice dynamics ' 286 WRITE(numout,*) '~~~~~~~~~~~~~~~ '283 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 287 284 WRITE(numout,*) ' Namelist namforcing:' 288 285 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90
r9019 r9169 512 512 REWIND( numnam_ice_ref ) ! Namelist namini in reference namelist : Ice initial state 513 513 READ ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 514 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 515 ! 514 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 516 515 REWIND( numnam_ice_cfg ) ! Namelist namini in configuration namelist : Ice initial state 517 516 READ ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 518 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namini in configuration namelist', lwp )517 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 519 518 IF(lwm) WRITE ( numoni, namini ) 520 519 ! … … 522 521 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu 523 522 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_smi) = sn_smi 524 !525 523 ! 526 524 IF(lwp) THEN ! control print -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90
r9019 r9169 657 657 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice 658 658 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 659 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 660 ! 659 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 661 660 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 662 661 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 663 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp )664 IF(lwm) WRITE 662 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp ) 663 IF(lwm) WRITE( numoni, namitd ) 665 664 ! 666 665 IF(lwp) THEN ! control print -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90
r9124 r9169 281 281 !! ** input : Namelist nampar 282 282 !!------------------------------------------------------------------- 283 INTEGER :: ios ! Local integer output status for namelist read 283 INTEGER :: ios ! Local integer 284 !! 284 285 NAMELIST/nampar/ jpl, nlay_i, nlay_s, nn_virtual_itd, ln_icedyn, ln_icethd, rn_amax_n, rn_amax_s, & 285 286 & cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir … … 288 289 REWIND( numnam_ice_ref ) ! Namelist nampar in reference namelist : Parameters for ice 289 290 READ ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 290 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 291 291 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 292 292 REWIND( numnam_ice_cfg ) ! Namelist nampar in configuration namelist : Parameters for ice 293 293 READ ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 294 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp )295 IF(lwm) WRITE 294 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 295 IF(lwm) WRITE( numoni, nampar ) 296 296 ! 297 297 IF(lwp) THEN ! control print 298 298 WRITE(numout,*) 299 WRITE(numout,*) ' par_init: ice parameters shared among all the routines'300 WRITE(numout,*) ' ~~~~~~~'301 WRITE(numout,*) ' Namelist nampar: '302 WRITE(numout,*) ' number of ice categories jpl= ', jpl303 WRITE(numout,*) ' number of ice layers nlay_i= ', nlay_i304 WRITE(numout,*) ' number of snow layers nlay_s= ', nlay_s305 WRITE(numout,*) ' virtual ITD param for jpl=1 (1-3) or not (0) nn_virtual_itd = ', nn_virtual_itd306 WRITE(numout,*) ' Ice dynamics (T) or not (F) ln_icedyn = ', ln_icedyn307 WRITE(numout,*) ' Ice thermodynamics (T) or not (F) ln_icethd = ', ln_icethd308 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n309 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s299 WRITE(numout,*) ' par_init: ice parameters shared among all the routines' 300 WRITE(numout,*) ' ~~~~~~~~' 301 WRITE(numout,*) ' Namelist nampar: ' 302 WRITE(numout,*) ' number of ice categories jpl = ', jpl 303 WRITE(numout,*) ' number of ice layers nlay_i = ', nlay_i 304 WRITE(numout,*) ' number of snow layers nlay_s = ', nlay_s 305 WRITE(numout,*) ' virtual ITD param for jpl=1 (1-3) or not (0) nn_virtual_itd = ', nn_virtual_itd 306 WRITE(numout,*) ' Ice dynamics (T) or not (F) ln_icedyn = ', ln_icedyn 307 WRITE(numout,*) ' Ice thermodynamics (T) or not (F) ln_icethd = ', ln_icethd 308 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 309 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 310 310 ENDIF 311 !312 311 ! !--- check consistency 313 312 IF ( jpl > 1 .AND. nn_virtual_itd == 1 ) THEN … … 323 322 IF( ln_bdy .AND. ln_icediachk ) CALL ctl_warn('par_init: online conservation check does not work with BDY') 324 323 ! 325 rdt_ice = REAL(nn_fsbc) * rdt !--- sea-ice timestep and i nverse324 rdt_ice = REAL(nn_fsbc) * rdt !--- sea-ice timestep and its inverse 326 325 r1_rdtice = 1._wp / rdt_ice 327 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice 326 IF(lwp) WRITE(numout,*) 327 IF(lwp) WRITE(numout,*) ' ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice 328 328 ! 329 329 r1_nlay_i = 1._wp / REAL( nlay_i, wp ) !--- inverse of nlay_i and nlay_s … … 356 356 h_s_b(:,:,:) = 0._wp 357 357 END WHERE 358 358 ! 359 359 ! ice velocities & total concentration 360 360 at_i_b(:,:) = SUM( a_i_b(:,:,:), dim=3 ) … … 412 412 tau_icebfr(:,:) = 0._wp ! landfast ice param only (clem: important to keep the init here) 413 413 cnd_ice (:,:,:) = 0._wp ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling) 414 414 ! 415 415 END SUBROUTINE diag_set0 416 416 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90
r9124 r9169 564 564 REWIND( numnam_ice_ref ) ! Namelist namthd in reference namelist : Ice thermodynamics 565 565 READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 566 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 567 566 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 568 567 REWIND( numnam_ice_cfg ) ! Namelist namthd in configuration namelist : Ice thermodynamics 569 568 READ ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 570 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 571 IF(lwm) WRITE ( numoni, namthd ) 572 ! 569 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 570 IF(lwm) WRITE( numoni, namthd ) 573 571 ! 574 572 IF(lwp) THEN ! control print 573 WRITE(numout,*) 575 574 WRITE(numout,*) 'ice_thd_init: Ice Thermodynamics' 576 575 WRITE(numout,*) '~~~~~~~~~~~~' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90
r9019 r9169 10 10 !! 'key_lim3' ESIM sea-ice model 11 11 !!---------------------------------------------------------------------- 12 !! ice_thd_da 13 !! ice_thd_da_init 12 !! ice_thd_da : sea ice lateral melting 13 !! ice_thd_da_init : sea ice lateral melting initialization 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! ocean parameters … … 28 28 PUBLIC ice_thd_da_init ! called by icestp.F90 29 29 30 ! ** namelist (namthd_da) **31 REAL(wp) :: rn_beta 32 REAL(wp) :: rn_dmin 30 ! !!** namelist (namthd_da) ** 31 REAL(wp) :: rn_beta ! coef. beta for lateral melting param. 32 REAL(wp) :: rn_dmin ! minimum floe diameter for lateral melting param. 33 33 34 34 !!---------------------------------------------------------------------- … … 118 118 ! 119 119 zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 120 ! 120 121 DO ji = 1, npti 121 122 ! --- Calculate reduction of total sea ice concentration --- ! … … 157 158 END SUBROUTINE ice_thd_da 158 159 160 159 161 SUBROUTINE ice_thd_da_init 160 162 !!----------------------------------------------------------------------- … … 169 171 !! ** input : Namelist namthd_da 170 172 !!------------------------------------------------------------------- 171 INTEGER :: ios ! Local integer output status for namelist read173 INTEGER :: ios ! Local integer 172 174 !! 173 175 NAMELIST/namthd_da/ rn_beta, rn_dmin … … 176 178 REWIND( numnam_ice_ref ) ! Namelist namthd_da in reference namelist : Ice thermodynamics 177 179 READ ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 178 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 179 180 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 180 181 REWIND( numnam_ice_cfg ) ! Namelist namthd_da in configuration namelist : Ice thermodynamics 181 182 READ ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 182 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 183 IF(lwm) WRITE ( numoni, namthd_da ) 184 ! 183 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 184 IF(lwm) WRITE( numoni, namthd_da ) 185 185 ! 186 186 IF(lwp) THEN ! control print 187 WRITE(numout,*) 187 188 WRITE(numout,*) 'ice_thd_da_init: Ice lateral melting' 188 189 WRITE(numout,*) '~~~~~~~~~~~~~~~' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90
r9019 r9169 39 39 PUBLIC ice_thd_do_init ! called by ice_stp 40 40 41 ! ** namelist (namthd_do) **42 REAL(wp) :: rn_hinew 43 LOGICAL :: ln_frazil 44 REAL(wp) :: rn_maxfraz 45 REAL(wp) :: rn_vfraz 46 REAL(wp) :: rn_Cfraz 41 ! !!** namelist (namthd_do) ** 42 REAL(wp) :: rn_hinew ! thickness for new ice formation (m) 43 LOGICAL :: ln_frazil ! use of frazil ice collection as function of wind (T) or not (F) 44 REAL(wp) :: rn_maxfraz ! maximum portion of frazil ice collecting at the ice bottom 45 REAL(wp) :: rn_vfraz ! threshold drift speed for collection of bottom frazil ice 46 REAL(wp) :: rn_Cfraz ! squeezing coefficient for collection of bottom frazil ice 47 47 48 48 !!---------------------------------------------------------------------- … … 78 78 !! update h_s_1d, h_i_1d 79 79 !!------------------------------------------------------------------------ 80 INTEGER :: ji, jj,jk,jl! dummy loop indices80 INTEGER :: ji, jj, jk, jl ! dummy loop indices 81 81 INTEGER :: iter ! - - 82 82 REAL(wp) :: ztmelts, zfrazb, zweight, zde ! local scalars 83 83 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf ! - - 84 84 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 85 85 ! 86 86 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 87 87 REAL(wp) :: zEi ! sea ice specific enthalpy (J/kg) 88 88 REAL(wp) :: zEw ! seawater specific enthalpy (J/kg) 89 89 REAL(wp) :: zfmdt ! mass flux x time step (kg/m2, >0 towards ocean) 90 90 ! 91 91 REAL(wp) :: zv_newfra 92 92 ! 93 93 INTEGER , DIMENSION(jpij) :: jcat ! indexes of categories where new ice grows 94 94 REAL(wp), DIMENSION(jpij) :: zswinew ! switch for new ice or not 95 95 ! 96 96 REAL(wp), DIMENSION(jpij) :: zv_newice ! volume of accreted ice 97 97 REAL(wp), DIMENSION(jpij) :: za_newice ! fractional area of accreted ice … … 104 104 REAL(wp), DIMENSION(jpij) :: zv_frazb ! accretion of frazil ice at the ice bottom 105 105 REAL(wp), DIMENSION(jpij) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 106 106 ! 107 107 REAL(wp), DIMENSION(jpij,jpl) :: zv_b ! old volume of ice in category jl 108 108 REAL(wp), DIMENSION(jpij,jpl) :: za_b ! old area of ice in category jl 109 109 ! 110 110 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_2d !: 1-D version of e_i 111 111 ! 112 112 REAL(wp), DIMENSION(jpi,jpj) :: zvrel ! relative ice / frazil velocity 113 113 ! 114 114 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 115 115 !!-----------------------------------------------------------------------! 116 116 117 IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)117 IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) 118 118 119 119 CALL ice_var_agg(1) … … 141 141 142 142 IF( ln_frazil ) THEN 143 143 ! 144 144 !-------------------- 145 145 ! Physical constants 146 146 !-------------------- 147 147 ht_i_new(:,:) = 0._wp 148 148 ! 149 149 zhicrit = 0.04 ! frazil ice thickness 150 150 ztwogp = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 151 151 zsqcd = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 152 152 zgamafr = 0.03 153 153 ! 154 154 DO jj = 2, jpjm1 155 155 DO ji = 2, jpim1 … … 204 204 iter = iter + 1 205 205 END DO 206 206 ! 207 207 ENDIF ! end of selection of pixels where ice forms 208 208 ! 209 209 END DO 210 210 END DO … … 222 222 !------------------------------------- 223 223 ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 224 npti = 0 ;nptidx(:) = 0224 npti = 0 ; nptidx(:) = 0 225 225 DO jj = 1, jpj 226 226 DO ji = 1, jpi … … 431 431 h_i_old (ji,nlay_i+1) = zv_newfra 432 432 eh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 433 END DO433 END DO 434 434 ! --- Ice enthalpy remapping --- ! 435 435 CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) ) 436 END DO436 END DO 437 437 438 438 !----------------- … … 474 474 ! 475 475 END SUBROUTINE ice_thd_do 476 476 477 477 478 SUBROUTINE ice_thd_do_init … … 487 488 !! ** input : Namelist namthd_do 488 489 !!------------------------------------------------------------------- 489 INTEGER :: ios ! Local integer output status for namelist read490 INTEGER :: ios ! Local integer 490 491 !! 491 492 NAMELIST/namthd_do/ rn_hinew, ln_frazil, rn_maxfraz, rn_vfraz, rn_Cfraz … … 494 495 REWIND( numnam_ice_ref ) ! Namelist namthd_do in reference namelist : Ice thermodynamics 495 496 READ ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 496 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 497 497 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 498 498 REWIND( numnam_ice_cfg ) ! Namelist namthd_do in configuration namelist : Ice thermodynamics 499 499 READ ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 500 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 501 IF(lwm) WRITE ( numoni, namthd_do ) 502 ! 500 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 501 IF(lwm) WRITE( numoni, namthd_do ) 503 502 ! 504 503 IF(lwp) THEN ! control print 504 WRITE(numout,*) 505 505 WRITE(numout,*) 'ice_thd_do_init: Ice growth in open water' 506 506 WRITE(numout,*) '~~~~~~~~~~~~~~~' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_pnd.F90
r9019 r9169 12 12 !! 'key_lim3' : ESIM sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_thd_pnd_init 15 !! ice_thd_pnd 14 !! ice_thd_pnd_init : some initialization and namelist read 15 !! ice_thd_pnd : main calling routine 16 16 !!---------------------------------------------------------------------- 17 17 USE phycst ! physical constants … … 32 32 PUBLIC ice_thd_pnd ! routine called by icestp.F90 33 33 34 INTEGER :: nice_pnd ! choice of the type of pond scheme35 ! 34 INTEGER :: nice_pnd ! choice of the type of pond scheme 35 ! ! associated indices: 36 36 INTEGER, PARAMETER :: np_pndNO = 0 ! No pond scheme 37 37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant pond scheme … … 54 54 !! 55 55 !! ** Method : brut force 56 !! 57 !! ** Action : - 58 !! - 59 !!------------------------------------------------------------------- 60 56 !!------------------------------------------------------------------- 57 ! 61 58 SELECT CASE ( nice_pnd ) 62 63 CASE (np_pndCST) 64 ! !-------------------------------! 65 CALL pnd_CST ! Constant melt ponds ! 66 ! !-------------------------------! 67 CASE (np_pndH12) 68 ! !-------------------------------! 69 CALL pnd_H12 ! Holland et al 2012 melt ponds ! 70 ! !-------------------------------! 59 ! 60 CASE (np_pndCST) ; CALL pnd_CST !== Constant melt ponds ==! 61 ! 62 CASE (np_pndH12) ; CALL pnd_H12 !== Holland et al 2012 melt ponds ==! 63 ! 71 64 END SELECT 72 65 ! 73 66 END SUBROUTINE ice_thd_pnd 74 67 68 75 69 SUBROUTINE pnd_CST 76 70 !!------------------------------------------------------------------- 77 71 !! *** ROUTINE pnd_CST *** 78 72 !! 79 !! ** Purpose :Compute melt pond evolution80 !! 81 !! ** Method :Melt pond fraction and thickness are prescribed82 !! 73 !! ** Purpose : Compute melt pond evolution 74 !! 75 !! ** Method : Melt pond fraction and thickness are prescribed 76 !! to non-zero values when t_su = 0C 83 77 !! 84 78 !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd) 85 79 !! 86 !! ** Note 87 !! 80 !! ** Note : Coupling with such melt ponds is only radiative 81 !! Advection, ridging, rafting... are bypassed 88 82 !! 89 83 !! ** References : Bush, G.W., and Trump, D.J. (2017) 90 !!91 84 !!------------------------------------------------------------------- 92 85 INTEGER :: ji ! loop indices 93 86 !!------------------------------------------------------------------- 94 87 DO ji = 1, npti 95 88 ! 96 89 IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 97 90 a_ip_frac_1d(ji) = rn_apnd … … 103 96 a_ip_1d(ji) = 0._wp 104 97 ENDIF 105 98 ! 106 99 END DO 107 100 ! 108 101 END SUBROUTINE pnd_CST 102 109 103 110 104 SUBROUTINE pnd_H12 … … 130 124 !! 131 125 !! ** References : Holland, M. M. et al (J Clim 2012) 132 !!133 126 !!------------------------------------------------------------------- 134 127 REAL(wp), PARAMETER :: zrmin = 0.15_wp ! minimum fraction of available meltwater retained for melt ponding 135 REAL(wp), PARAMETER :: zrmax = 0.70_wp ! maximum '' '' '' '' ''128 REAL(wp), PARAMETER :: zrmax = 0.70_wp ! maximum - - - - - 136 129 REAL(wp), PARAMETER :: zpnd_aspect = 0.8_wp ! pond aspect ratio 137 130 REAL(wp), PARAMETER :: zTp = -2._wp ! reference temperature 138 131 ! 139 132 REAL(wp) :: zfr_mlt ! fraction of available meltwater retained for melt ponding 140 133 REAL(wp) :: zdv_mlt ! available meltwater for melt ponding … … 143 136 REAL(wp) :: z1_zpnd_aspect ! inverse pond aspect ratio 144 137 REAL(wp) :: zfac, zdum 145 138 ! 146 139 INTEGER :: ji ! loop indices 147 140 !!------------------------------------------------------------------- 148 z1_rhofw = 1. / rhofw149 z1_zpnd_aspect = 1. / zpnd_aspect141 z1_rhofw = 1._wp / rhofw 142 z1_zpnd_aspect = 1._wp / zpnd_aspect 150 143 z1_Tp = 1._wp / zTp 151 144 … … 162 155 ! !--------------------------------! 163 156 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) ! record pond volume at previous time step 164 157 ! 165 158 ! available meltwater for melt ponding [m, >0] and fraction 166 159 zdv_mlt = -( dh_i_surf(ji)*rhoic + dh_s_mlt(ji)*rhosn ) * z1_rhofw * a_i_1d(ji) 167 160 zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji) ! from CICE doc 168 161 !zfr_mlt = zrmin + zrmax * a_i_1d(ji) ! from Holland paper 169 162 ! 170 163 !--- Pond gowth ---! 171 164 ! v_ip should never be negative, otherwise code crashes 172 165 ! MV: as far as I saw, UM5 can create very small negative v_ip values (not Prather) 173 166 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 174 167 ! 175 168 ! melt pond mass flux (<0) 176 169 IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN 177 170 zfac = zfr_mlt * zdv_mlt * rhofw * r1_rdtice 178 171 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 179 172 ! 180 173 ! adjust ice/snow melting flux to balance melt pond flux (>0) 181 174 zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) … … 183 176 wfx_sum_1d(ji) = wfx_sum_1d(ji) * (1._wp + zdum) 184 177 ENDIF 185 178 ! 186 179 !--- Pond contraction (due to refreezing) ---! 187 180 v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 188 181 ! 189 182 ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 190 183 ! h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i … … 192 185 a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 193 186 h_ip_1d(ji) = zpnd_aspect * a_ip_frac_1d(ji) 194 187 ! 195 188 ENDIF 196 189 END DO 197 190 ! 198 191 END SUBROUTINE pnd_H12 192 199 193 200 194 SUBROUTINE ice_thd_pnd_init … … 210 204 !! ** input : Namelist namthd_pnd 211 205 !!------------------------------------------------------------------- 212 INTEGER :: ios, ioptio ! Local integer output status for namelist read 206 INTEGER :: ios, ioptio ! Local integer 207 !! 213 208 NAMELIST/namthd_pnd/ ln_pnd_H12, ln_pnd_fwb, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 214 209 !!------------------------------------------------------------------- 215 210 ! 216 211 REWIND( numnam_ice_ref ) ! Namelist namthd_pnd in reference namelist : Melt Ponds 217 212 READ ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 218 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist', lwp ) 219 213 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist', lwp ) 220 214 REWIND( numnam_ice_cfg ) ! Namelist namthd_pnd in configuration namelist : Melt Ponds 221 215 READ ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 222 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp )216 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp ) 223 217 IF(lwm) WRITE ( numoni, namthd_pnd ) 224 218 ! 225 219 IF(lwp) THEN ! control print 226 220 WRITE(numout,*) … … 242 236 IF( ln_pnd_H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12 ; ENDIF 243 237 IF( ioptio > 1 ) CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 244 238 ! 245 239 SELECT CASE( nice_pnd ) 246 240 CASE( np_pndNO ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90
r9019 r9169 12 12 !! 'key_lim3' ESIM sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_thd_sal 15 !! ice_thd_sal_init 14 !! ice_thd_sal : salinity variations in the ice 15 !! ice_thd_sal_init : initialization 16 16 !!---------------------------------------------------------------------- 17 17 USE dom_oce ! ocean space and time domain … … 32 32 33 33 ! ** namelist (namthd_sal) ** 34 REAL(wp) :: rn_sal_gd 35 REAL(wp) :: rn_time_gd 36 REAL(wp) :: rn_sal_fl 37 REAL(wp) :: rn_time_fl 34 REAL(wp) :: rn_sal_gd ! restoring salinity for gravity drainage [PSU] 35 REAL(wp) :: rn_time_gd ! restoring time constant for gravity drainage (= 20 days) [s] 36 REAL(wp) :: rn_sal_fl ! restoring salinity for flushing [PSU] 37 REAL(wp) :: rn_time_fl ! restoring time constant for gravity drainage (= 10 days) [s] 38 38 39 39 !!---------------------------------------------------------------------- … … 56 56 !!--------------------------------------------------------------------- 57 57 LOGICAL, INTENT(in) :: ld_sal ! gravity drainage and flushing or not 58 ! 58 59 INTEGER :: ji, jk ! dummy loop indices 59 60 REAL(wp) :: iflush, igravdr ! local scalars … … 66 67 ! !---------------------------------------------! 67 68 CASE( 2 ) ! time varying salinity with linear profile ! 68 !!---------------------------------------------!69 ! !---------------------------------------------! 69 70 z1_time_gd = 1._wp / rn_time_gd * rdt_ice 70 71 z1_time_fl = 1._wp / rn_time_fl * rdt_ice 71 72 ! 72 73 DO ji = 1, npti 73 74 ! 74 75 !--------------------------------------------------------- 75 76 ! Update ice salinity from snow-ice and bottom growth … … 82 83 s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si 83 84 ENDIF 84 85 ! 85 86 IF( ld_sal ) THEN 86 87 !--------------------------------------------------------- … … 100 101 ENDIF 101 102 END DO 102 103 ! 103 104 ! Salinity profile 104 105 CALL ice_var_salprof1d 105 106 ! 106 ! !---------------------------------------------!107 CASE( 3 ) ! constant salinity with a fixed profile ! (Schwarzacher (1959) multiyear salinity profile(mean = 2.30)108 ! !---------------------------------------------!107 ! !----------------------------------------! 108 CASE( 3 ) ! constant salinity with a fixed profile ! (Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 109 ! !----------------------------------------! 109 110 CALL ice_var_salprof1d 111 ! 112 END SELECT 110 113 ! 111 END SELECT112 !113 114 END SUBROUTINE ice_thd_sal 114 115 … … 125 126 !! ** input : Namelist namthd_sal 126 127 !!------------------------------------------------------------------- 127 INTEGER :: ios ! Local integer output status for namelist read128 INTEGER :: ios ! Local integer 128 129 !! 129 130 NAMELIST/namthd_sal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, & … … 133 134 REWIND( numnam_ice_ref ) ! Namelist namthd_sal in reference namelist : Ice salinity 134 135 READ ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 135 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 136 ! 136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 137 137 REWIND( numnam_ice_cfg ) ! Namelist namthd_sal in configuration namelist : Ice salinity 138 138 READ ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 139 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp )139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp ) 140 140 IF(lwm) WRITE ( numoni, namthd_sal ) 141 141 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90
r9124 r9169 100 100 REWIND( numnam_ice_ref ) ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 101 101 READ ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 102 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 103 102 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 104 103 REWIND( numnam_ice_cfg ) ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 105 104 READ ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 106 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 107 IF(lwm) WRITE ( numoni, namthd_zdf ) 108 ! 105 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 106 IF(lwm) WRITE( numoni, namthd_zdf ) 109 107 ! 110 108 IF(lwp) THEN ! control print 109 WRITE(numout,*) 111 110 WRITE(numout,*) 'ice_thd_zdf_init: Ice vertical heat diffusion' 112 111 WRITE(numout,*) '~~~~~~~~~~~~~~~~' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r9167 r9169 24 24 ! 25 25 IF( .NOT. Agrif_Root() ) THEN 26 jpni = Agrif_Parent(jpni)27 jpnj = Agrif_Parent(jpnj)26 jpni = Agrif_Parent(jpni) 27 jpnj = Agrif_Parent(jpnj) 28 28 jpnij = Agrif_Parent(jpnij) 29 jpiglo 30 jpjglo 31 jpi 32 jpj 29 jpiglo = nbcellsx + 2 + 2*nbghostcells 30 jpjglo = nbcellsy + 2 + 2*nbghostcells 31 jpi = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 32 jpj = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 33 33 ! JC: change to allow for different vertical levels 34 34 ! jpk is already set … … 36 36 ! hold parent grid vertical levels number (set earlier) 37 37 ! jpk = jpkglo 38 jpim1 39 jpjm1 40 jpkm1 41 jpij 42 nperio 43 jperio 38 jpim1 = jpi-1 39 jpjm1 = jpj-1 40 jpkm1 = MAX( 1, jpk-1 ) 41 jpij = jpi*jpj 42 nperio = 0 43 jperio = 0 44 44 ENDIF 45 45 ! … … 780 780 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom 781 781 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 782 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 783 782 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 784 783 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom 785 784 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 786 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )785 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 787 786 IF(lwm) WRITE ( numond, namagrif ) 788 787 ! … … 796 795 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 797 796 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 798 WRITE(numout,*)799 797 ENDIF 800 798 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r9125 r9169 234 234 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 235 235 READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 236 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 237 236 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 238 237 REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 239 238 READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 240 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp )239 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 241 240 IF(lwm) WRITE ( numond, namdta_dyn ) 242 241 ! ! store namelist information in an array -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r9124 r9169 174 174 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark 175 175 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 176 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 177 176 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 178 177 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark 179 178 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 180 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )179 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 181 180 182 181 ! 183 182 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints & Benchmark 184 183 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 185 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 186 184 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 187 185 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark 188 186 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 189 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )187 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 190 188 191 189 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r9168 r9169 421 421 ! keep full control of the configuration namelist 422 422 READ ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 423 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp )423 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 424 424 IF(lwm) WRITE ( numond, nambdy_index ) 425 425 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r9168 r9169 59 59 REAL(wp) , DIMENSION(jpidta,jpjdta) :: gphidta, glamdta, zdist ! Global lat/lon 60 60 !! 61 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, &62 & rn_atfp , rn_rdt ,nn_closea, ln_crs, jphgr_msh, &61 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, ln_meshmask, rn_hmin, & 62 & rn_atfp , rn_rdt , ln_crs, jphgr_msh, & 63 63 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 64 64 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & … … 69 69 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 70 70 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 71 !72 71 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 73 72 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) … … 182 181 jpjzoom = iloc(2) + njmpp - 2 ! corner index of the zoom domain. 183 182 184 IF 183 IF(lwp) THEN 185 184 WRITE(numout,*) 186 185 WRITE(numout,*) 'dom_c1d : compute jpizoom & jpjzoom from global mesh and given coordinates' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r9019 r9169 122 122 !: 1 = binning centers at equator (north fold my have artifacts) 123 123 !: for even reduction factors, equator placed in bin biased south 124 INTEGER :: nn_msh_crs = 1 !: Organization of mesh mask output 125 !: 0 = no mesh mask output 126 !: 1 = unified mesh mask output 127 !: 2 = 2 separate mesh mask output 128 !: 3 = 3 separate mesh mask output 129 INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 130 LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence 124 LOGICAL :: ln_msh_crs = 1 !: =T Create a meshmask file for CRS 125 INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 126 LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence 131 127 ! 132 128 INTEGER :: nrestx, nresty !: for determining odd or even reduction factor -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r9125 r9169 48 48 !! ** Output files : mesh_hgr_crs.nc, mesh_zgr_crs.nc, mesh_mask.nc 49 49 !!---------------------------------------------------------------------- 50 !! 51 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 52 INTEGER :: inum1 ! temprary units for 'mesh.nc' file 53 INTEGER :: inum2 ! temprary units for 'mask.nc' file 54 INTEGER :: inum3 ! temprary units for 'mesh_hgr.nc' file 55 INTEGER :: inum4 ! temprary units for 'mesh_zgr.nc' file 50 INTEGER :: ji, jj, jk ! dummy loop indices 51 INTEGER :: inum ! local units for 'mesh_mask.nc' file 56 52 INTEGER :: iif, iil, ijf, ijl 57 CHARACTER(len=21) :: clnam0 ! filename (mesh and mask informations) 58 CHARACTER(len=21) :: clnam1 ! filename (mesh informations) 59 CHARACTER(len=21) :: clnam2 ! filename (mask informations) 60 CHARACTER(len=21) :: clnam3 ! filename (horizontal mesh informations) 61 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 ! ! workspaces 64 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: zprt, zprw 65 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zdepu, zdepv 66 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: ze3tp, ze3wp 67 !!---------------------------------------------------------------------- 68 ! 69 ze3tp(:,:) = 0.0 70 ze3wp(:,:) = 0.0 71 53 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) 54 ! ! workspace 55 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: zprt, zprw 56 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zdepu, zdepv 57 !!---------------------------------------------------------------------- 58 ! 72 59 ! 73 60 IF(lwp) WRITE(numout,*) 74 IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask information file(s)' 75 IF(lwp) WRITE(numout,*) '~~~~~~~' 76 77 clnam0 = 'mesh_mask_crs' ! filename (mesh and mask informations) 78 clnam1 = 'mesh_crs' ! filename (mesh informations) 79 clnam2 = 'mask_crs' ! filename (mask informations) 80 clnam3 = 'mesh_hgr_crs' ! filename (horizontal mesh informations) 81 clnam4 = 'mesh_zgr_crs' ! filename (vertical mesh informations) 82 83 84 SELECT CASE ( MOD(nn_msh_crs, 3) ) 85 ! ! ============================ 86 CASE ( 1 ) ! create 'mesh_mask.nc' file 87 ! ! ============================ 88 CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 89 inum2 = inum0 ! put all the informations 90 inum3 = inum0 ! in unit inum0 91 inum4 = inum0 92 93 ! ! ============================ 94 CASE ( 2 ) ! create 'mesh.nc' and 95 ! ! 'mask.nc' files 96 ! ! ============================ 97 CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 98 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 99 inum3 = inum1 ! put mesh informations 100 inum4 = inum1 ! in unit inum1 101 ! ! ============================ 102 CASE ( 0 ) ! create 'mesh_hgr.nc' 103 ! ! 'mesh_zgr.nc' and 104 ! ! 'mask.nc' files 105 ! ! ============================ 106 CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 107 CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 108 CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 109 ! 110 END SELECT 61 IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask file' 62 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 63 64 clnam = 'mesh_mask_crs' ! filename (mesh and mask informations) 65 66 67 ! ! ============================ 68 ! ! create 'mesh_mask.nc' file 69 ! ! ============================ 70 ! 71 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 111 72 112 !======================================================== 113 ! ! masks (inum2) 114 CALL iom_rstput( 0, 0, inum2, 'tmask', tmask_crs, ktype = jp_i1 ) ! ! land-sea mask 115 CALL iom_rstput( 0, 0, inum2, 'umask', umask_crs, ktype = jp_i1 ) 116 CALL iom_rstput( 0, 0, inum2, 'vmask', vmask_crs, ktype = jp_i1 ) 117 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask_crs, ktype = jp_i1 ) 73 CALL iom_rstput( 0, 0, inum, 'tmask', tmask_crs, ktype = jp_i1 ) ! land-sea mask 74 CALL iom_rstput( 0, 0, inum, 'umask', umask_crs, ktype = jp_i1 ) 75 CALL iom_rstput( 0, 0, inum, 'vmask', vmask_crs, ktype = jp_i1 ) 76 CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 118 77 119 78 … … 147 106 ENDIF 148 107 149 CALL iom_rstput( 0, 0, inum 2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 )108 CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 150 109 ! ! unique point mask 151 110 CALL dom_uniq_crs( zprw, 'U' ) 152 111 zprt = umask_crs(:,:,1) * zprw 153 CALL iom_rstput( 0, 0, inum 2, 'umaskutil', zprt, ktype = jp_i1 )112 CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 ) 154 113 CALL dom_uniq_crs( zprw, 'V' ) 155 114 zprt = vmask_crs(:,:,1) * zprw 156 CALL iom_rstput( 0, 0, inum 2, 'vmaskutil', zprt, ktype = jp_i1 )115 CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 ) 157 116 CALL dom_uniq_crs( zprw, 'F' ) 158 117 zprt = fmask_crs(:,:,1) * zprw 159 CALL iom_rstput( 0, 0, inum 2, 'fmaskutil', zprt, ktype = jp_i1 )118 CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 ) 160 119 !======================================================== 161 ! ! horizontal mesh (inum3)162 CALL iom_rstput( 0, 0, inum 3, 'glamt', glamt_crs, ktype = jp_r4 ) ! ! latitude163 CALL iom_rstput( 0, 0, inum 3, 'glamu', glamu_crs, ktype = jp_r4 )164 CALL iom_rstput( 0, 0, inum 3, 'glamv', glamv_crs, ktype = jp_r4 )165 CALL iom_rstput( 0, 0, inum 3, 'glamf', glamf_crs, ktype = jp_r4 )166 167 CALL iom_rstput( 0, 0, inum 3, 'gphit', gphit_crs, ktype = jp_r4 ) ! ! longitude168 CALL iom_rstput( 0, 0, inum 3, 'gphiu', gphiu_crs, ktype = jp_r4 )169 CALL iom_rstput( 0, 0, inum 3, 'gphiv', gphiv_crs, ktype = jp_r4 )170 CALL iom_rstput( 0, 0, inum 3, 'gphif', gphif_crs, ktype = jp_r4 )171 172 CALL iom_rstput( 0, 0, inum 3, 'e1t', e1t_crs, ktype = jp_r8 ) ! ! e1 scale factors173 CALL iom_rstput( 0, 0, inum 3, 'e1u', e1u_crs, ktype = jp_r8 )174 CALL iom_rstput( 0, 0, inum 3, 'e1v', e1v_crs, ktype = jp_r8 )175 CALL iom_rstput( 0, 0, inum 3, 'e1f', e1f_crs, ktype = jp_r8 )176 177 CALL iom_rstput( 0, 0, inum 3, 'e2t', e2t_crs, ktype = jp_r8 ) ! ! e2 scale factors178 CALL iom_rstput( 0, 0, inum 3, 'e2u', e2u_crs, ktype = jp_r8 )179 CALL iom_rstput( 0, 0, inum 3, 'e2v', e2v_crs, ktype = jp_r8 )180 CALL iom_rstput( 0, 0, inum 3, 'e2f', e2f_crs, ktype = jp_r8 )181 182 CALL iom_rstput( 0, 0, inum 3, 'ff', ff_crs, ktype = jp_r8 ) ! ! coriolis factor120 ! ! horizontal mesh 121 CALL iom_rstput( 0, 0, inum, 'glamt', glamt_crs, ktype = jp_r4 ) ! ! latitude 122 CALL iom_rstput( 0, 0, inum, 'glamu', glamu_crs, ktype = jp_r4 ) 123 CALL iom_rstput( 0, 0, inum, 'glamv', glamv_crs, ktype = jp_r4 ) 124 CALL iom_rstput( 0, 0, inum, 'glamf', glamf_crs, ktype = jp_r4 ) 125 126 CALL iom_rstput( 0, 0, inum, 'gphit', gphit_crs, ktype = jp_r4 ) ! ! longitude 127 CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu_crs, ktype = jp_r4 ) 128 CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv_crs, ktype = jp_r4 ) 129 CALL iom_rstput( 0, 0, inum, 'gphif', gphif_crs, ktype = jp_r4 ) 130 131 CALL iom_rstput( 0, 0, inum, 'e1t', e1t_crs, ktype = jp_r8 ) ! ! e1 scale factors 132 CALL iom_rstput( 0, 0, inum, 'e1u', e1u_crs, ktype = jp_r8 ) 133 CALL iom_rstput( 0, 0, inum, 'e1v', e1v_crs, ktype = jp_r8 ) 134 CALL iom_rstput( 0, 0, inum, 'e1f', e1f_crs, ktype = jp_r8 ) 135 136 CALL iom_rstput( 0, 0, inum, 'e2t', e2t_crs, ktype = jp_r8 ) ! ! e2 scale factors 137 CALL iom_rstput( 0, 0, inum, 'e2u', e2u_crs, ktype = jp_r8 ) 138 CALL iom_rstput( 0, 0, inum, 'e2v', e2v_crs, ktype = jp_r8 ) 139 CALL iom_rstput( 0, 0, inum, 'e2f', e2f_crs, ktype = jp_r8 ) 140 141 CALL iom_rstput( 0, 0, inum, 'ff', ff_crs, ktype = jp_r8 ) ! ! coriolis factor 183 142 184 143 !======================================================== 185 ! ! vertical mesh (inum4)144 ! ! vertical mesh 186 145 ! ! note that mbkt is set to 1 over land ==> use surface tmask_crs 187 146 zprt(:,:) = tmask_crs(:,:,1) * REAL( mbkt_crs(:,:) , wp ) 188 CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 189 190 IF( ln_zps ) THEN ! z-coordinate - partial steps 191 192 193 IF ( nn_msh_crs <= 6 ) THEN 194 CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_crs ) 195 CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_crs ) 196 CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs ) 197 CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs ) 198 ELSE 199 DO jj = 1,jpj_crs 200 DO ji = 1,jpi_crs 201 ze3tp(ji,jj) = e3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 202 ze3wp(ji,jj) = e3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 203 END DO 204 END DO 205 206 CALL crs_lbc_lnk( ze3tp,'T', 1.0 ) 207 CALL crs_lbc_lnk( ze3wp,'W', 1.0 ) 208 209 CALL iom_rstput( 0, 0, inum4, 'e3t_ps', ze3tp ) 210 CALL iom_rstput( 0, 0, inum4, 'e3w_ps', ze3wp ) 211 ENDIF 212 213 IF ( nn_msh_crs <= 3 ) THEN 214 CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_crs, ktype = jp_r4 ) 215 DO jk = 1,jpk 216 DO jj = 1, jpj_crsm1 217 DO ji = 1, jpi_crsm1 ! jes what to do for fs_jpim1??vector opt. 218 zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj ,jk) ) * umask_crs(ji,jj,jk) 219 zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji ,jj+1,jk) ) * vmask_crs(ji,jj,jk) 220 END DO 221 END DO 222 END DO 223 224 CALL crs_lbc_lnk( zdepu,'U', 1. ) ; CALL crs_lbc_lnk( zdepv,'V', 1. ) 225 CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 ) 226 CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 ) 227 CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_crs, ktype = jp_r4 ) 228 ELSE 229 DO jj = 1,jpj_crs 230 DO ji = 1,jpi_crs 231 zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj) ) * tmask(ji,jj,1) 232 zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1) 233 END DO 234 END DO 235 CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 ) 236 CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 237 ENDIF 238 239 CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d ) ! ! reference z-coord. 240 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 241 CALL iom_rstput( 0, 0, inum4, 'e3t_1d' , e3t_1d ) 242 CALL iom_rstput( 0, 0, inum4, 'e3w_1d' , e3w_1d ) 243 244 CALL iom_rstput( 0, 0, inum4, 'ocean_volume_t', ocean_volume_crs_t ) 245 CALL iom_rstput( 0, 0, inum4, 'facvol_t' , facvol_t ) 246 CALL iom_rstput( 0, 0, inum4, 'facvol_w' , facvol_w ) 247 CALL iom_rstput( 0, 0, inum4, 'facsurfu' , facsurfu ) 248 CALL iom_rstput( 0, 0, inum4, 'facsurfv' , facsurfv ) 249 CALL iom_rstput( 0, 0, inum4, 'e1e2w_msk', e1e2w_msk ) 250 CALL iom_rstput( 0, 0, inum4, 'e2e3u_msk', e2e3u_msk ) 251 CALL iom_rstput( 0, 0, inum4, 'e1e3v_msk', e1e3v_msk ) 252 CALL iom_rstput( 0, 0, inum4, 'e1e2w' , e1e2w_crs ) 253 CALL iom_rstput( 0, 0, inum4, 'e2e3u' , e2e3u_crs ) 254 CALL iom_rstput( 0, 0, inum4, 'e1e3v' , e1e3v_crs ) 255 CALL iom_rstput( 0, 0, inum4, 'bt' , bt_crs ) 256 CALL iom_rstput( 0, 0, inum4, 'r1_bt' , r1_bt_crs ) 257 258 CALL iom_rstput( 0, 0, inum4, 'crs_surfu_wgt', crs_surfu_wgt ) 259 CALL iom_rstput( 0, 0, inum4, 'crs_surfv_wgt', crs_surfv_wgt ) 260 CALL iom_rstput( 0, 0, inum4, 'crs_volt_wgt' , crs_volt_wgt ) 261 262 ENDIF 263 264 IF( ln_zco ) THEN 265 ! ! z-coordinate - full steps 266 CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d ) ! ! depth 267 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 268 CALL iom_rstput( 0, 0, inum4, 'e3t_1d' , e3t_1d ) ! ! scale factors 269 CALL iom_rstput( 0, 0, inum4, 'e3w_1d' , e3w_1d ) 270 ENDIF 147 CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 148 ! 149 CALL iom_rstput( 0, 0, inum, 'e3t', e3t_crs ) 150 CALL iom_rstput( 0, 0, inum, 'e3w', e3w_crs ) 151 CALL iom_rstput( 0, 0, inum, 'e3u', e3u_crs ) 152 CALL iom_rstput( 0, 0, inum, 'e3v', e3v_crs ) 153 ! 154 CALL iom_rstput( 0, 0, inum, 'gdept', gdept_crs, ktype = jp_r4 ) 155 DO jk = 1,jpk 156 DO jj = 1, jpj_crsm1 157 DO ji = 1, jpi_crsm1 ! jes what to do for fs_jpim1??vector opt. 158 zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj ,jk) ) * umask_crs(ji,jj,jk) 159 zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji ,jj+1,jk) ) * vmask_crs(ji,jj,jk) 160 END DO 161 END DO 162 END DO 163 CALL crs_lbc_lnk( zdepu,'U', 1. ) ; CALL crs_lbc_lnk( zdepv,'V', 1. ) 164 ! 165 CALL iom_rstput( 0, 0, inum, 'gdepu', zdepu, ktype = jp_r4 ) 166 CALL iom_rstput( 0, 0, inum, 'gdepv', zdepv, ktype = jp_r4 ) 167 CALL iom_rstput( 0, 0, inum, 'gdepw', gdepw_crs, ktype = jp_r4 ) 168 ! 169 CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d ) ! ! reference z-coord. 170 CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d ) 171 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d ) 172 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d ) 173 ! 174 CALL iom_rstput( 0, 0, inum, 'ocean_volume_t', ocean_volume_crs_t ) 175 CALL iom_rstput( 0, 0, inum, 'facvol_t' , facvol_t ) 176 CALL iom_rstput( 0, 0, inum, 'facvol_w' , facvol_w ) 177 CALL iom_rstput( 0, 0, inum, 'facsurfu' , facsurfu ) 178 CALL iom_rstput( 0, 0, inum, 'facsurfv' , facsurfv ) 179 CALL iom_rstput( 0, 0, inum, 'e1e2w_msk', e1e2w_msk ) 180 CALL iom_rstput( 0, 0, inum, 'e2e3u_msk', e2e3u_msk ) 181 CALL iom_rstput( 0, 0, inum, 'e1e3v_msk', e1e3v_msk ) 182 CALL iom_rstput( 0, 0, inum, 'e1e2w' , e1e2w_crs ) 183 CALL iom_rstput( 0, 0, inum, 'e2e3u' , e2e3u_crs ) 184 CALL iom_rstput( 0, 0, inum, 'e1e3v' , e1e3v_crs ) 185 CALL iom_rstput( 0, 0, inum, 'bt' , bt_crs ) 186 CALL iom_rstput( 0, 0, inum, 'r1_bt' , r1_bt_crs ) 187 ! 188 CALL iom_rstput( 0, 0, inum, 'crs_surfu_wgt', crs_surfu_wgt ) 189 CALL iom_rstput( 0, 0, inum, 'crs_surfv_wgt', crs_surfv_wgt ) 190 CALL iom_rstput( 0, 0, inum, 'crs_volt_wgt' , crs_volt_wgt ) 271 191 ! ! ============================ 272 192 ! ! close the files 273 193 ! ! ============================ 274 SELECT CASE ( MOD(nn_msh_crs, 3) ) 275 CASE ( 1 ) 276 CALL iom_close( inum0 ) 277 CASE ( 2 ) 278 CALL iom_close( inum1 ) 279 CALL iom_close( inum2 ) 280 CASE ( 0 ) 281 CALL iom_close( inum2 ) 282 CALL iom_close( inum3 ) 283 CALL iom_close( inum4 ) 284 END SELECT 194 CALL iom_close( inum ) 285 195 ! 286 196 END SUBROUTINE crs_dom_wri … … 296 206 !! 2) check which elements have been changed 297 207 !!---------------------------------------------------------------------- 298 !299 208 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 300 209 REAL(wp), DIMENSION(:,:), INTENT(inout) :: puniq ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r9168 r9169 73 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w 74 74 75 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn75 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, ln_msh_crs, nn_crs_kz, ln_crs_wn 76 76 !!---------------------------------------------------------------------- 77 77 ! … … 96 96 WRITE(numout,*) ' coarsening factor in j-direction nn_facty = ', nn_facty 97 97 WRITE(numout,*) ' bin centering preference nn_binref = ', nn_binref 98 WRITE(numout,*) ' create (=1) a mesh file or not (=0) nn_msh_crs = ', nn_msh_crs98 WRITE(numout,*) ' create a mesh file (=T) ln_msh_crs = ', ln_msh_crs 99 99 WRITE(numout,*) ' type of Kz coarsening (0,1,2) nn_crs_kz = ', nn_crs_kz 100 100 WRITE(numout,*) ' wn coarsened or computed using hdivn ln_crs_wn = ', ln_crs_wn … … 228 228 !--------------------------------------------------------- 229 229 230 IF( nn_msh_crs > 0) THEN230 IF( ln_msh_crs ) THEN 231 231 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 232 232 CALL crs_dom_wri -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r9168 r9169 231 231 232 232 SUBROUTINE dia_hsb_rst( kt, cdrw ) 233 !!---------------------------------------------------------------------234 !! *** ROUTINE dia_hsb_rst ***235 !!236 !! ** Purpose : Read or write DIA file in restart file237 !!238 !! ** Method : use of IOM library239 !!----------------------------------------------------------------------240 INTEGER , INTENT(in) :: kt ! ocean time-step241 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag242 !243 INTEGER :: ji, jj, jk ! dummy loop indices244 !!----------------------------------------------------------------------245 !246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise247 IF( ln_rstart ) THEN !* Read the restart file248 !249 IF(lwp) WRITE(numout,*) '~~~~~~~'250 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp251 IF(lwp) WRITE(numout,*) '~~~~~~~'252 CALL iom_get( numror, 'frc_v', frc_v )253 CALL iom_get( numror, 'frc_t', frc_t )254 CALL iom_get( numror, 'frc_s', frc_s )255 IF( ln_linssh ) THEN256 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )257 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )258 ENDIF259 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling260 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) )261 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) )262 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) )263 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) )264 IF( ln_linssh ) THEN265 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) )266 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) )267 ENDIF268 ELSE269 IF(lwp) WRITE(numout,*) '~~~~~~~'270 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '271 IF(lwp) WRITE(numout,*) '~~~~~~~'272 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface273 ssh_ini(:,:) = sshn(:,:) ! initial ssh274 DO jk = 1, jpk275 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).276 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors277 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content278 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content279 END DO280 frc_v = 0._wp ! volume trend due to forcing281 frc_t = 0._wp ! heat content - - - -282 frc_s = 0._wp ! salt content - - - -283 IF( ln_linssh ) THEN284 IF( ln_isfcav ) THEN285 DO ji=1,jpi286 DO jj=1,jpj287 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh288 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh289 ENDDO290 ENDDO291 ELSE292 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh293 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh294 END IF295 frc_wn_t = 0._wp ! initial heat content misfit due to free surface296 frc_wn_s = 0._wp ! initial salt content misfit due to free surface297 ENDIF298 ENDIF299 300 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file301 ! ! -------------------302 IF(lwp) WRITE(numout,*) '~~~~~~~'303 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp304 IF(lwp) WRITE(numout,*) '~~~~~~~'305 306 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v )307 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t )308 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s )309 IF( ln_linssh ) THEN310 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )312 ENDIF313 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling314 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) )315 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) )316 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) )317 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) )318 IF( ln_linssh ) THEN319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) )320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) )321 ENDIF322 !323 ENDIF324 !233 !!--------------------------------------------------------------------- 234 !! *** ROUTINE dia_hsb_rst *** 235 !! 236 !! ** Purpose : Read or write DIA file in restart file 237 !! 238 !! ** Method : use of IOM library 239 !!---------------------------------------------------------------------- 240 INTEGER , INTENT(in) :: kt ! ocean time-step 241 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 242 ! 243 INTEGER :: ji, jj, jk ! dummy loop indices 244 !!---------------------------------------------------------------------- 245 ! 246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 IF( ln_rstart ) THEN !* Read the restart file 248 ! 249 IF(lwp) WRITE(numout,*) 250 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 251 IF(lwp) WRITE(numout,*) 252 CALL iom_get( numror, 'frc_v', frc_v ) 253 CALL iom_get( numror, 'frc_t', frc_t ) 254 CALL iom_get( numror, 'frc_s', frc_s ) 255 IF( ln_linssh ) THEN 256 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 257 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 258 ENDIF 259 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 260 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 261 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 262 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 263 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 264 IF( ln_linssh ) THEN 265 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 267 ENDIF 268 ELSE 269 IF(lwp) WRITE(numout,*) 270 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state ' 271 IF(lwp) WRITE(numout,*) 272 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 273 ssh_ini(:,:) = sshn(:,:) ! initial ssh 274 DO jk = 1, jpk 275 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 276 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 277 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 278 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 279 END DO 280 frc_v = 0._wp ! volume trend due to forcing 281 frc_t = 0._wp ! heat content - - - - 282 frc_s = 0._wp ! salt content - - - - 283 IF( ln_linssh ) THEN 284 IF( ln_isfcav ) THEN 285 DO ji = 1, jpi 286 DO jj = 1, jpj 287 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 288 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 289 END DO 290 END DO 291 ELSE 292 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 293 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 294 END IF 295 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 296 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 297 ENDIF 298 ENDIF 299 ! 300 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 301 ! ! ------------------- 302 IF(lwp) WRITE(numout,*) 303 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 304 IF(lwp) WRITE(numout,*) 305 ! 306 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 309 IF( ln_linssh ) THEN 310 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 312 ENDIF 313 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 314 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 315 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 316 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 317 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 318 IF( ln_linssh ) THEN 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 321 ENDIF 322 ! 323 ENDIF 324 ! 325 325 END SUBROUTINE dia_hsb_rst 326 326 … … 338 338 !! - Compute coefficients for conversion 339 339 !!--------------------------------------------------------------------------- 340 INTEGER :: ierror ! local integer 341 INTEGER :: ios 340 INTEGER :: ierror, ios ! local integer 342 341 !! 343 342 NAMELIST/namhsb/ ln_diahsb 344 343 !!---------------------------------------------------------------------- 345 344 ! 345 IF(lwp) THEN 346 WRITE(numout,*) 347 WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics' 348 WRITE(numout,*) '~~~~~~~~~~~~ ' 349 ENDIF 346 350 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist 347 351 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) … … 350 354 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 351 355 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 352 IF(lwm) WRITE 356 IF(lwm) WRITE( numond, namhsb ) 353 357 354 358 IF(lwp) THEN 355 WRITE(numout,*)356 WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics'357 WRITE(numout,*) '~~~~~~~~~~~~ '358 359 WRITE(numout,*) ' Namelist namhsb :' 359 360 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r9161 r9169 123 123 ENDIF 124 124 ELSE 125 IF( lwp ) WRITE(numout,*) 'closea_mask field not found in domain_cfg file. No closed seas defined.' 125 IF( lwp ) WRITE(numout,*) 126 IF( lwp ) WRITE(numout,*) ' ==>>> closea_mask field not found in domain_cfg file.' 127 IF( lwp ) WRITE(numout,*) ' No closed seas defined.' 128 IF( lwp ) WRITE(numout,*) 126 129 l_sbc_clo = .false. 127 130 jncs = 0 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r9161 r9169 31 31 ! !!* Namelist namdom : time & space domain * 32 32 LOGICAL , PUBLIC :: ln_linssh !: =T linear free surface ==>> model level are fixed in time 33 INTEGER , PUBLIC :: nn_msh !: >0create a mesh-mask file (mesh_mask.nc)33 LOGICAL , PUBLIC :: ln_meshmask !: =T create a mesh-mask file (mesh_mask.nc) 34 34 REAL(wp), PUBLIC :: rn_isfhmin !: threshold to discriminate grounded ice to floating ice 35 35 REAL(wp), PUBLIC :: rn_rdt !: time step for the dynamics and tracer -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r9168 r9169 70 70 !! and scale factors, and the coriolis factor 71 71 !! - dom_zgr: define the vertical coordinate and the bathymetry 72 !! - dom_wri: create the meshmask file if nn_msh=172 !! - dom_wri: create the meshmask file (ln_meshmask=T) 73 73 !! - 1D configuration, move Coriolis, u and v at T-point 74 74 !!---------------------------------------------------------------------- … … 110 110 END SELECT 111 111 WRITE(numout,*) ' Ocean model configuration used:' 112 WRITE(numout,*) ' cn_cfg = ', cn_cfg 113 WRITE(numout,*) ' nn_cfg = ', nn_cfg 112 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 114 113 ENDIF 115 114 ! … … 176 175 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 177 176 ! 178 IF( nn_msh > 0 .AND. .NOT. ln_iscpl ) CALL dom_wri ! Create a domain file 179 IF( nn_msh > 0 .AND. ln_iscpl .AND. .NOT. ln_rstart ) CALL dom_wri ! Create a domain file 180 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 181 ! 182 177 IF( ln_meshmask .AND. .NOT.ln_iscpl ) CALL dom_wri ! Create a domain file 178 IF( ln_meshmask .AND. ln_iscpl .AND. .NOT.ln_rstart ) CALL dom_wri ! Create a domain file 179 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 180 ! 181 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file 182 ! 183 183 IF(lwp) THEN 184 184 WRITE(numout,*) 185 WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh 185 WRITE(numout,*) 'dom_init : ==>>> END of domain initialization' 186 WRITE(numout,*) '~~~~~~~~' 186 187 WRITE(numout,*) 187 188 ENDIF 188 !189 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file190 189 ! 191 190 END SUBROUTINE dom_init … … 269 268 !!---------------------------------------------------------------------- 270 269 USE ioipsl 270 !! 271 INTEGER :: ios ! Local integer 272 ! 271 273 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 272 274 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & … … 274 276 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , & 275 277 & ln_cfmeta, ln_iscpl 276 NAMELIST/namdom/ ln_linssh, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs278 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask 277 279 #if defined key_netcdf4 278 280 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 279 281 #endif 280 INTEGER :: ios ! Local integer output status for namelist read 281 !!---------------------------------------------------------------------- 282 !!---------------------------------------------------------------------- 283 ! 284 IF(lwp) THEN 285 WRITE(numout,*) 286 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 287 WRITE(numout,*) '~~~~~~~ ' 288 ENDIF 282 289 ! 283 290 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run … … 290 297 ! 291 298 IF(lwp) THEN ! control print 292 WRITE(numout,*) 293 WRITE(numout,*) 'dom_nam : domain initialization through namelist read' 294 WRITE(numout,*) '~~~~~~~ ' 295 WRITE(numout,*) ' Namelist namrun' 296 WRITE(numout,*) ' job number nn_no = ', nn_no 297 WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp 298 WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in 299 WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir 300 WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out 301 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir 302 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 303 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 304 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 305 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 306 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 307 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 308 WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0 309 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 310 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 299 WRITE(numout,*) ' Namelist : namrun' 300 WRITE(numout,*) ' job number nn_no = ', nn_no 301 WRITE(numout,*) ' experiment name for output cn_exp = ', TRIM( cn_exp ) 302 WRITE(numout,*) ' file prefix restart input cn_ocerst_in = ', TRIM( cn_ocerst_in ) 303 WRITE(numout,*) ' restart input directory cn_ocerst_indir = ', TRIM( cn_ocerst_indir ) 304 WRITE(numout,*) ' file prefix restart output cn_ocerst_out = ', TRIM( cn_ocerst_out ) 305 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 306 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 307 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 308 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 309 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 310 WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend 311 WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0 312 WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0 313 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 314 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 311 315 IF( ln_rst_list ) THEN 312 WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist316 WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist 313 317 ELSE 314 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock318 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 315 319 ENDIF 316 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write317 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland318 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta319 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber320 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz321 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl320 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 321 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 322 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta 323 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 324 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 325 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl 322 326 ENDIF 323 327 … … 336 340 IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 337 341 IF(lwp) WRITE(numout,*) 338 IF(lwp) WRITE(numout,*)' Start from rest (ln_rstart=F) ==>>> an Euler initial time step is used,'339 IF(lwp) WRITE(numout,*)' 342 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 343 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0 ' 340 344 neuler = 0 341 345 ENDIF 342 346 ! ! control of output frequency 343 IF 347 IF( nstock == 0 .OR. nstock > nitend ) THEN 344 348 WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 345 349 CALL ctl_warn( ctmp1 ) … … 376 380 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 377 381 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 378 IF(lwm) WRITE 382 IF(lwm) WRITE( numond, namdom ) 379 383 ! 380 384 IF(lwp) THEN 381 385 WRITE(numout,*) 382 WRITE(numout,*) ' Namelist namdom : space & time domain' 383 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 384 WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh 385 WRITE(numout,*) ' = 0 no file created ' 386 WRITE(numout,*) ' = 1 mesh_mask ' 387 WRITE(numout,*) ' = 2 mesh and mask ' 388 WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask' 389 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' (m)' 390 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 391 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 392 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 393 ENDIF 394 395 call flush( numout ) 396 ! 397 ! ! ! conversion DOCTOR names into model names (this should disappear soon) 398 atfp = rn_atfp 399 rdt = rn_rdt 386 WRITE(numout,*) ' Namelist : namdom --- space & time domain' 387 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 388 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 389 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]' 390 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 391 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 392 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 393 ENDIF 394 ! 395 ! ! conversion DOCTOR names into model names (this should disappear soon) 396 atfp = rn_atfp 397 rdt = rn_rdt 400 398 401 399 #if defined key_netcdf4 … … 403 401 REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF 404 402 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 405 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )403 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 406 404 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 407 405 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 408 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )406 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 409 407 IF(lwm) WRITE( numond, namnc4 ) 410 408 … … 412 410 WRITE(numout,*) 413 411 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters' 414 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i= ', nn_nchunks_i415 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j= ', nn_nchunks_j416 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k= ', nn_nchunks_k417 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip= ', ln_nc4zip412 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 413 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j 414 WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k 415 WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 418 416 ENDIF 419 417 … … 487 485 !! ** Purpose : read the domain size in domain configuration file 488 486 !! 489 !! ** Method : 490 !! 487 !! ** Method : read the cn_domcfg NetCDF file 491 488 !!---------------------------------------------------------------------- 492 489 CHARACTER(len=*), DIMENSION(:), INTENT(out) :: ldtxt ! stored print information … … 503 500 ii = 1 504 501 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 505 WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' 502 WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' ; ii = ii+1 506 503 WRITE(ldtxt(ii),*) '~~~~~~~~~~ ' ; ii = ii+1 507 504 ! … … 515 512 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = INT( zorca_res ) 516 513 ! 517 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1518 WRITE(ldtxt(ii),*) ' ==>>> ORCA configuration ' ; ii = ii+1519 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1514 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 515 WRITE(ldtxt(ii),*) ' ==>>> ORCA configuration ' ; ii = ii+1 516 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 520 517 ! 521 518 ELSE !- cd_cfg & k_cfg are not used -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r9019 r9169 91 91 IF( ln_read_cfg ) THEN !== read in mesh_mask.nc file ==! 92 92 IF(lwp) WRITE(numout,*) 93 IF(lwp) WRITE(numout,*) ' 93 IF(lwp) WRITE(numout,*) ' ==>>> read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 94 94 ! 95 95 CALL hgr_read ( glamt , glamu , glamv , glamf , & ! geographic position (required) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r9168 r9169 119 119 WRITE(numout,*) ' consistency with analytical form ln_vorlat = ',ln_vorlat 120 120 ENDIF 121 122 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral free-slip ' 123 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral no-slip ' 124 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral partial-slip ' 125 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral strong-slip ' 121 ! 122 IF(lwp) WRITE(numout,*) 123 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral free-slip' 124 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral no-slip' 125 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral partial-slip' 126 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral strong-slip' 126 127 ELSE 127 128 WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r9124 r9169 49 49 !! diagnostic computation. 50 50 !! 51 !! ** Method : Write in a file all the arrays generated in routines 52 !! domhgr, domzgr, and dommsk. Note: the file contain depends on 53 !! the vertical coord. used (z-coord, partial steps, s-coord) 54 !! MOD(nn_msh, 3) = 1 : 'mesh_mask.nc' file 55 !! = 2 : 'mesh.nc' and mask.nc' files 56 !! = 0 : 'mesh_hgr.nc', 'mesh_zgr.nc' and 57 !! 'mask.nc' files 58 !! For huge size domain, use option 2 or 3 depending on your 59 !! vertical coordinate. 60 !! 61 !! if nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 62 !! if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 63 !! corresponding to the depth of the bottom t- and w-points 64 !! if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the 65 !! thickness (e3[tw]_ps) of the bottom points 51 !! ** Method : create a file with all domain related arrays 66 52 !! 67 53 !! ** output file : meshmask.nc : domain size, horizontal grid-point position, … … 196 182 CALL iom_close( inum ) ! close the files 197 183 ! ! ============================ 198 !199 184 END SUBROUTINE dom_wri 200 185 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r9161 r9169 87 87 IF( ln_read_cfg ) THEN !== read in mesh_mask.nc file ==! 88 88 IF(lwp) WRITE(numout,*) 89 IF(lwp) WRITE(numout,*) ' 89 IF(lwp) WRITE(numout,*) ' ==>>> Read vertical mesh in ', TRIM( cn_domcfg ), ' file' 90 90 ! 91 91 CALL zgr_read ( ln_zco , ln_zps , ln_sco, ln_isfcav, & -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r9090 r9169 77 77 78 78 ! ! create a domain file 79 IF( nn_msh /= 0.AND. ln_iscpl ) CALL dom_wri79 IF( ln_meshmask .AND. ln_iscpl ) CALL dom_wri 80 80 ! 81 81 IF ( ln_hsb ) THEN -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r9019 r9169 113 113 ! ------------------------ 114 114 IF(lwp) WRITE(numout,*) 115 IF(lwp) WRITE(numout,*) ' 115 IF(lwp) WRITE(numout,*) ' Constants' 116 116 117 117 IF(lwp) WRITE(numout,*) 118 IF(lwp) WRITE(numout,*) ' 118 IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi 119 119 120 120 rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp … … 126 126 #endif 127 127 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) ' day rday = ', rday, ' s' 129 IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 130 IF(lwp) WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 131 IF(lwp) WRITE(numout,*) ' omega omega = ', omega, ' s^-1' 132 128 IF(lwp) WRITE(numout,*) ' day rday = ', rday, ' s' 129 IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 130 IF(lwp) WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 131 IF(lwp) WRITE(numout,*) ' omega omega = ', omega, ' s^-1' 133 132 IF(lwp) WRITE(numout,*) 134 IF(lwp) WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 135 IF(lwp) WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 136 IF(lwp) WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 137 IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 138 133 IF(lwp) WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 134 IF(lwp) WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 135 IF(lwp) WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 136 IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 139 137 IF(lwp) WRITE(numout,*) 140 IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m' 141 IF(lwp) WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 142 138 IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m' 139 IF(lwp) WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 143 140 IF(lwp) WRITE(numout,*) 144 IF(lwp) WRITE(numout,*) ' 145 IF(lwp) WRITE(numout,*) ' 146 IF(lwp) WRITE(numout,*) ' 147 IF(lwp) WRITE(numout,*) ' 148 149 IF(lwp) WRITE(numout,*) ' 141 IF(lwp) WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 142 IF(lwp) WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 143 IF(lwp) WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 144 IF(lwp) WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 145 IF(lwp) WRITE(numout,*) 146 IF(lwp) WRITE(numout,*) ' reference density and heat capacity now defined in eosbn2.f90' 150 147 151 148 #if defined key_lim3 || defined key_cice … … 163 160 WRITE(numout,*) 164 161 #if defined key_cice 165 WRITE(numout,*) ' 162 WRITE(numout,*) ' thermal conductivity of the snow = ', rcdsn , ' J/s/m/K' 166 163 #endif 167 WRITE(numout,*) ' 168 WRITE(numout,*) ' 169 WRITE(numout,*) ' 164 WRITE(numout,*) ' thermal conductivity of pure ice = ', rcdic , ' J/s/m/K' 165 WRITE(numout,*) ' fresh ice specific heat = ', cpic , ' J/kg/K' 166 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 170 167 #if defined key_lim3 || defined key_cice 171 WRITE(numout,*) ' 168 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow = ', lsub , ' J/kg' 172 169 #else 173 WRITE(numout,*) ' 174 WRITE(numout,*) ' 175 WRITE(numout,*) ' 176 WRITE(numout,*) ' 170 WRITE(numout,*) ' density times specific heat for snow = ', rcpsn , ' J/m^3/K' 171 WRITE(numout,*) ' density times specific heat for ice = ', rcpic , ' J/m^3/K' 172 WRITE(numout,*) ' volumetric latent heat fusion of sea ice = ', xlic , ' J/m' 173 WRITE(numout,*) ' latent heat of sublimation of snow = ', xsn , ' J/kg' 177 174 #endif 178 WRITE(numout,*) ' 179 WRITE(numout,*) ' 180 WRITE(numout,*) ' 181 WRITE(numout,*) ' 182 WRITE(numout,*) ' 183 WRITE(numout,*) ' 184 WRITE(numout,*) ' 185 WRITE(numout,*) ' 186 WRITE(numout,*) ' 187 WRITE(numout,*) ' 188 WRITE(numout,*) ' 175 WRITE(numout,*) ' volumetric latent heat fusion of snow = ', xlsn , ' J/m^3' 176 WRITE(numout,*) ' density of sea ice = ', rhoic , ' kg/m^3' 177 WRITE(numout,*) ' density of snow = ', rhosn , ' kg/m^3' 178 WRITE(numout,*) ' density of freshwater (in melt ponds) = ', rhofw , ' kg/m^3' 179 WRITE(numout,*) ' emissivity of snow or ice = ', emic 180 WRITE(numout,*) ' salinity of ice = ', sice , ' psu' 181 WRITE(numout,*) ' salinity of sea = ', soce , ' psu' 182 WRITE(numout,*) ' latent heat of evaporation (water) = ', cevap , ' J/m^3' 183 WRITE(numout,*) ' correction factor for solar radiation = ', srgamma 184 WRITE(numout,*) ' von Karman constant = ', vkarmn 185 WRITE(numout,*) ' Stefan-Boltzmann constant = ', stefan , ' J/s/m^2/K^4' 189 186 WRITE(numout,*) 190 WRITE(numout,*) ' 187 WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad 191 188 WRITE(numout,*) 192 WRITE(numout,*) ' 189 WRITE(numout,*) ' smallest real computer value rsmall = ', rsmall 193 190 ENDIF 194 191 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r9168 r9169 194 194 !!---------------------------------------------------------------------- 195 195 ! 196 IF(lwp) THEN 197 WRITE(numout,*) 198 WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 199 WRITE(numout,*) '~~~~~~~~~~~~' 200 ENDIF 201 ! 196 202 REWIND( numnam_ref ) ! Namelist namdyn_spg in reference namelist : Free surface 197 203 READ ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) … … 204 210 ! 205 211 IF(lwp) THEN ! Namelist print 206 WRITE(numout,*) 207 WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 208 WRITE(numout,*) '~~~~~~~~~~~' 209 WRITE(numout,*) ' Explicit free surface ln_dynspg_exp = ', ln_dynspg_exp 210 WRITE(numout,*) ' Free surface with time splitting ln_dynspg_ts = ', ln_dynspg_ts 212 WRITE(numout,*) ' Namelist : namdyn_spg ' 213 WRITE(numout,*) ' Explicit free surface ln_dynspg_exp = ', ln_dynspg_exp 214 WRITE(numout,*) ' Free surface with time splitting ln_dynspg_ts = ', ln_dynspg_ts 211 215 ENDIF 212 216 ! ! Control of surface pressure gradient scheme options -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r9124 r9169 1424 1424 ! Print results 1425 1425 IF(lwp) WRITE(numout,*) 1426 IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface'1427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ '1426 IF(lwp) WRITE(numout,*) 'dyn_spg_ts_init : split-explicit free surface' 1427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 1428 1428 IF( ln_bt_auto ) THEN 1429 IF(lwp) WRITE(numout,*) ' ln_ts_auto =.true. Automatically set nn_baro '1429 IF(lwp) WRITE(numout,*) ' ln_ts_auto =.true. Automatically set nn_baro ' 1430 1430 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1431 1431 ELSE 1432 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_baro in namelist '1432 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_baro in namelist nn_baro = ', nn_baro 1433 1433 ENDIF 1434 1434 1435 1435 IF(ln_bt_av) THEN 1436 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true.=> Time averaging over nn_baro time steps is on '1436 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_baro time steps is on ' 1437 1437 ELSE 1438 IF(lwp) WRITE(numout,*) ' ln_bt_av =.false. => No time averaging of barotropic variables '1438 IF(lwp) WRITE(numout,*) ' ln_bt_av =.false. => No time averaging of barotropic variables ' 1439 1439 ENDIF 1440 1440 ! … … 1456 1456 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1457 1457 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1458 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, 2' )1458 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' ) 1459 1459 END SELECT 1460 1460 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r9168 r9169 229 229 IF( jpnj == 1 ) ibondj(ii,ij) = 2 230 230 ibondi(ii,ij) = 0 231 IF( MOD(jarea,jpni) == 1) ibondi(ii,ij) = -1232 IF( MOD(jarea,jpni) == 0) ibondi(ii,ij) = 1233 IF( jpni == 1) ibondi(ii,ij) = 2231 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 232 IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1 233 IF( jpni == 1 ) ibondi(ii,ij) = 2 234 234 235 235 ! Subdomain neighbors … … 242 242 ilei(ii,ij) = ili - nn_hls 243 243 244 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1245 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili244 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 245 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 246 246 ildj(ii,ij) = 1 + nn_hls 247 247 ilej(ii,ij) = ilj - nn_hls 248 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1249 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj248 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 249 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 250 250 251 251 ! warning ii*ij (zone) /= nproc (processors)! … … 326 326 il1 = il1+ifreq 327 327 END DO 328 9400 FORMAT(' ***',20('*************',a3))329 9403 FORMAT(' * ',20(' * ',a3))330 9401 FORMAT(' ',20(' ',i3,' '))331 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))332 9404 FORMAT(' * ',20(' ',i3,' * '))328 9400 FORMAT(' ***' ,20('*************',a3) ) 329 9403 FORMAT(' * ',20(' * ',a3) ) 330 9401 FORMAT(' ' ,20(' ',i3,' ') ) 331 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ') ) 332 9404 FORMAT(' * ' ,20(' ',i3,' * ') ) 333 333 ENDIF 334 334 … … 479 479 IF(lwp) THEN 480 480 WRITE(numout,*) 481 WRITE(numout,*) ' nproc = ', nproc 482 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 483 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 484 WRITE(numout,*) ' nbondi = ', nbondi 485 WRITE(numout,*) ' nbondj = ', nbondj 486 WRITE(numout,*) ' npolj = ', npolj 487 WRITE(numout,*) ' nperio = ', nperio 488 WRITE(numout,*) ' nlci = ', nlci 489 WRITE(numout,*) ' nlcj = ', nlcj 490 WRITE(numout,*) ' nimpp = ', nimpp 491 WRITE(numout,*) ' njmpp = ', njmpp 492 WRITE(numout,*) ' nreci = ', nreci 493 WRITE(numout,*) ' nrecj = ', nrecj 494 WRITE(numout,*) ' nn_hls = ', nn_hls 481 WRITE(numout,*) ' resulting internal parameters : ' 482 WRITE(numout,*) ' nproc = ', nproc 483 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 484 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 485 WRITE(numout,*) ' nbondi = ', nbondi 486 WRITE(numout,*) ' nbondj = ', nbondj 487 WRITE(numout,*) ' npolj = ', npolj 488 WRITE(numout,*) ' nperio = ', nperio 489 WRITE(numout,*) ' nlci = ', nlci 490 WRITE(numout,*) ' nlcj = ', nlcj 491 WRITE(numout,*) ' nimpp = ', nimpp 492 WRITE(numout,*) ' njmpp = ', njmpp 493 WRITE(numout,*) ' nreci = ', nreci 494 WRITE(numout,*) ' nrecj = ', nrecj 495 WRITE(numout,*) ' nn_hls = ', nn_hls 495 496 ENDIF 496 497 497 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' )498 499 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) &498 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' ) 499 500 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 500 501 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 501 502 … … 503 504 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 504 505 CALL mpp_ini_north 505 IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 506 IF(lwp) WRITE(numout,*) 507 IF(lwp) WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 506 508 ENDIF 507 509 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r9168 r9169 142 142 ! ! Parameter control 143 143 IF( ln_dynldf_NONE ) THEN 144 IF(lwp) WRITE(numout,*) ' No viscous operator selected. ahmt and ahmf are not allocated'144 IF(lwp) WRITE(numout,*) ' ==>>> No viscous operator selected. ahmt and ahmf are not allocated' 145 145 l_ldfdyn_time = .FALSE. 146 146 RETURN … … 173 173 ! 174 174 CASE( 0 ) !== constant ==! 175 IF(lwp) WRITE(numout,*) ' 175 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = constant ' 176 176 ahmt(:,:,:) = zah0 * tmask(:,:,:) 177 177 ahmf(:,:,:) = zah0 * fmask(:,:,:) 178 178 ! 179 179 CASE( 10 ) !== fixed profile ==! 180 IF(lwp) WRITE(numout,*) ' 180 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F( depth )' 181 181 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 182 182 ahmf(:,:,1) = zah0 * fmask(:,:,1) … … 184 184 ! 185 185 CASE ( -20 ) !== fixed horizontal shape read in file ==! 186 IF(lwp) WRITE(numout,*) ' 186 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 187 187 CALL iom_open( 'eddy_viscosity_2D.nc', inum ) 188 188 CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) ) … … 198 198 ! 199 199 CASE( 20 ) !== fixed horizontal shape ==! 200 IF(lwp) WRITE(numout,*) ' 200 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 201 201 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 202 202 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor^3 203 203 ! 204 204 CASE( -30 ) !== fixed 3D shape read in file ==! 205 IF(lwp) WRITE(numout,*) ' 205 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 206 206 CALL iom_open( 'eddy_viscosity_3D.nc', inum ) 207 207 CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt ) … … 216 216 ! 217 217 CASE( 30 ) !== fixed 3D shape ==! 218 IF(lwp) WRITE(numout,*) ' 218 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F( latitude, longitude, depth )' 219 219 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 220 220 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor … … 223 223 ! 224 224 CASE( 31 ) !== time varying 3D field ==! 225 IF(lwp) WRITE(numout,*) ' 226 IF(lwp) WRITE(numout,*) ' 225 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F( latitude, longitude, depth , time )' 226 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 227 227 ! 228 228 l_ldfdyn_time = .TRUE. ! will be calculated by call to ldf_dyn routine in step.F90 229 229 ! 230 230 CASE( 32 ) !== time varying 3D field ==! 231 IF(lwp) WRITE(numout,*) ' 232 IF(lwp) WRITE(numout,*) ' proportional to the local deformation rate and gridscale (Smagorinsky)'233 IF(lwp) WRITE(numout,*) ' : L^2|D| or L^4|D|/8'231 IF(lwp) WRITE(numout,*) ' ==>>> momentum mixing coef. = F( latitude, longitude, depth , time )' 232 IF(lwp) WRITE(numout,*) ' proportional to the local deformation rate and gridscale (Smagorinsky)' 233 IF(lwp) WRITE(numout,*) ' : L^2|D| or L^4|D|/8' 234 234 ! 235 235 l_ldfdyn_time = .TRUE. ! will be calculated by call to ldf_dyn routine in step.F90 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r9168 r9169 126 126 !!---------------------------------------------------------------------- 127 127 ! 128 ! Choice of lateral tracer physics129 ! =================================130 !131 REWIND( numnam_ref ) ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers132 READ ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901)133 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp )134 !135 REWIND( numnam_cfg ) ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers136 READ ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 )137 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp )138 IF(lwm) WRITE ( numond, namtra_ldf )139 !140 128 IF(lwp) THEN ! control print 141 129 WRITE(numout,*) 142 130 WRITE(numout,*) 'ldf_tra_init : lateral tracer physics' 143 131 WRITE(numout,*) '~~~~~~~~~~~~ ' 144 WRITE(numout,*) ' Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 132 ENDIF 133 ! 134 ! Choice of lateral tracer physics 135 ! ================================= 136 ! 137 REWIND( numnam_ref ) ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 138 READ ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 139 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 140 REWIND( numnam_cfg ) ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 141 READ ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 142 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 143 IF(lwm) WRITE( numond, namtra_ldf ) 144 ! 145 IF(lwp) THEN ! control print 146 WRITE(numout,*) ' Namelist : namtra_ldf --- lateral mixing parameters (type, direction, coefficients)' 145 147 WRITE(numout,*) ' type :' 146 148 WRITE(numout,*) ' no explicit diffusion ln_traldf_NONE = ', ln_traldf_NONE … … 166 168 ! 167 169 IF( ln_traldf_NONE ) THEN 168 IF(lwp) WRITE(numout,*) ' No diffusive operator selected. ahtu and ahtv are not allocated'170 IF(lwp) WRITE(numout,*) ' ==>>> No diffusive operator selected. ahtu and ahtv are not allocated' 169 171 l_ldftra_time = .FALSE. 170 172 RETURN … … 196 198 ! 197 199 CASE( 0 ) !== constant ==! 198 IF(lwp) WRITE(numout,*) ' 200 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = constant = ', rn_aht_0 199 201 ahtu(:,:,:) = zah0 * umask(:,:,:) 200 202 ahtv(:,:,:) = zah0 * vmask(:,:,:) 201 203 ! 202 204 CASE( 10 ) !== fixed profile ==! 203 IF(lwp) WRITE(numout,*) ' 205 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( depth )' 204 206 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 205 207 ahtv(:,:,1) = zah0 * vmask(:,:,1) … … 207 209 ! 208 210 CASE ( -20 ) !== fixed horizontal shape read in file ==! 209 IF(lwp) WRITE(numout,*) ' 211 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 210 212 CALL iom_open( 'eddy_diffusivity_2D.nc', inum ) 211 213 CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) … … 218 220 ! 219 221 CASE( 20 ) !== fixed horizontal shape ==! 220 IF(lwp) WRITE(numout,*) ' 222 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 221 223 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 222 224 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 223 225 ! 224 226 CASE( 21 ) !== time varying 2D field ==! 225 IF(lwp) WRITE(numout,*) ' 226 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )'227 IF(lwp) WRITE(numout,*) ' min value = 0.1 * rn_aht_0'228 IF(lwp) WRITE(numout,*) ' max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)'229 IF(lwp) WRITE(numout,*) ' increased to rn_aht_0 within 20N-20S'227 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( latitude, longitude, time )' 228 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 229 IF(lwp) WRITE(numout,*) ' min value = 0.1 * rn_aht_0' 230 IF(lwp) WRITE(numout,*) ' max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 231 IF(lwp) WRITE(numout,*) ' increased to rn_aht_0 within 20N-20S' 230 232 ! 231 233 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 … … 236 238 ! 237 239 CASE( -30 ) !== fixed 3D shape read in file ==! 238 IF(lwp) WRITE(numout,*) ' 240 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 239 241 CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 240 242 CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) … … 247 249 ! 248 250 CASE( 30 ) !== fixed 3D shape ==! 249 IF(lwp) WRITE(numout,*) ' 251 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( latitude, longitude, depth )' 250 252 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 251 253 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor … … 254 256 ! 255 257 CASE( 31 ) !== time varying 3D field ==! 256 IF(lwp) WRITE(numout,*) ' 257 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12'258 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( latitude, longitude, depth , time )' 259 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 258 260 ! 259 261 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 … … 382 384 !!---------------------------------------------------------------------- 383 385 ! 386 IF(lwp) THEN ! control print 387 WRITE(numout,*) 388 WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 389 WRITE(numout,*) '~~~~~~~~~~~~ ' 390 ENDIF 391 ! 384 392 REWIND( numnam_ref ) ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 385 393 READ ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) … … 392 400 393 401 IF(lwp) THEN ! control print 394 WRITE(numout,*)395 WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization'396 WRITE(numout,*) '~~~~~~~~~~~~ '397 402 WRITE(numout,*) ' Namelist namtra_ldfeiv : ' 398 403 WRITE(numout,*) ' Eddy Induced Velocity (eiv) param. ln_ldfeiv = ', ln_ldfeiv … … 415 420 ! 416 421 CASE( 0 ) !== constant ==! 417 IF(lwp) WRITE(numout,*) ' 422 IF(lwp) WRITE(numout,*) ' ==>>> eddy induced velocity coef. = constant = ', rn_aeiv_0 418 423 aeiu(:,:,:) = rn_aeiv_0 419 424 aeiv(:,:,:) = rn_aeiv_0 420 425 ! 421 426 CASE( 10 ) !== fixed profile ==! 422 IF(lwp) WRITE(numout,*) ' 427 IF(lwp) WRITE(numout,*) ' ==>>> eddy induced velocity coef. = F( depth )' 423 428 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 424 429 aeiv(:,:,1) = rn_aeiv_0 … … 426 431 ! 427 432 CASE ( -20 ) !== fixed horizontal shape read in file ==! 428 IF(lwp) WRITE(numout,*) ' 433 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 429 434 CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 430 435 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) … … 437 442 ! 438 443 CASE( 20 ) !== fixed horizontal shape ==! 439 IF(lwp) WRITE(numout,*) ' 444 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 440 445 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 441 446 ! 442 447 CASE( 21 ) !== time varying 2D field ==! 443 IF(lwp) WRITE(numout,*) ' 444 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )'448 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( latitude, longitude, time )' 449 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 445 450 ! 446 451 l_ldfeiv_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 447 452 ! 448 453 CASE( -30 ) !== fixed 3D shape read in file ==! 449 IF(lwp) WRITE(numout,*) ' 454 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 450 455 CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 451 456 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu ) … … 454 459 ! 455 460 CASE( 30 ) !== fixed 3D shape ==! 456 IF(lwp) WRITE(numout,*) ' 461 IF(lwp) WRITE(numout,*) ' ==>>> tracer mixing coef. = F( latitude, longitude, depth )' 457 462 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 458 463 ! ! reduction with depth … … 464 469 ! 465 470 ELSE 466 IF(lwp) WRITE(numout,*) ' eddy induced velocity param is NOT used neither diagnosed'471 IF(lwp) WRITE(numout,*) ' ==>>> eddy induced velocity param is NOT used neither diagnosed' 467 472 ln_ldfeiv_dia = .FALSE. 468 473 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r9168 r9169 155 155 WRITE(numout,*) ' Stokes drift corr. to vert. velocity ln_sdw = ', ln_sdw 156 156 WRITE(numout,*) ' vertical parametrization nn_sdrift = ', nn_sdrift 157 WRITE(numout,*) ' wave modified ocean stress ln_tauwoc 157 WRITE(numout,*) ' wave modified ocean stress ln_tauwoc = ', ln_tauwoc 158 158 WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw 159 159 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r9168 r9169 241 241 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl 242 242 REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: zrnf 243 ! 243 !! 244 244 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, & 245 245 & sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, & … … 292 292 ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow) 293 293 IF(lwp) WRITE(numout,*) 294 IF(lwp) WRITE(numout,*) ' 294 IF(lwp) WRITE(numout,*) ' ==>>> runoffs inflow read in a file' 295 295 IF( ierror > 0 ) THEN 296 296 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_rnf structure' ) ; RETURN … … 303 303 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure 304 304 IF(lwp) WRITE(numout,*) 305 IF(lwp) WRITE(numout,*) ' 305 IF(lwp) WRITE(numout,*) ' ==>>> runoffs temperatures read in a file' 306 306 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 307 307 IF( ierror > 0 ) THEN … … 315 315 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 316 316 IF(lwp) WRITE(numout,*) 317 IF(lwp) WRITE(numout,*) ' 317 IF(lwp) WRITE(numout,*) ' ==>>> runoffs salinities read in a file' 318 318 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 319 319 IF( ierror > 0 ) THEN … … 327 327 IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file 328 328 IF(lwp) WRITE(numout,*) 329 IF(lwp) WRITE(numout,*) ' 329 IF(lwp) WRITE(numout,*) ' ==>>> runoffs depth read in a file' 330 330 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 331 331 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year … … 364 364 ! 365 365 IF(lwp) WRITE(numout,*) 366 IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff'367 IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max368 IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max369 IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file366 IF(lwp) WRITE(numout,*) ' ==>>> depth of runoff computed once from max value of runoff' 367 IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 368 IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max 369 IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file 370 370 371 371 CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file … … 420 420 ! 421 421 IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff 422 IF(lwp) WRITE(numout,*) ' 422 IF(lwp) WRITE(numout,*) ' ==>>> create runoff depht file' 423 423 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 424 424 CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) … … 453 453 ENDIF 454 454 IF(lwp) WRITE(numout,*) 455 IF(lwp) WRITE(numout,*) ' 455 IF(lwp) WRITE(numout,*) ' ==>>> Specific treatment used in vicinity of river mouths :' 456 456 IF(lwp) WRITE(numout,*) ' - Increase Kz in surface layers (if rn_hrnf > 0 )' 457 457 IF(lwp) WRITE(numout,*) ' by ', rn_avt_rnf,' m2/s over ', nkrnf, ' w-levels' … … 463 463 ELSE ! No treatment at river mouths 464 464 IF(lwp) WRITE(numout,*) 465 IF(lwp) WRITE(numout,*) ' 465 IF(lwp) WRITE(numout,*) ' ==>>> No specific treatment at river mouths' 466 466 rnfmsk (:,:) = 0._wp 467 467 rnfmsk_z(:) = 0._wp -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r9168 r9169 158 158 !!---------------------------------------------------------------------- 159 159 ! 160 160 IF(lwp) THEN 161 WRITE(numout,*) 162 WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 163 WRITE(numout,*) '~~~~~~~ ' 164 ENDIF 165 ! 161 166 REWIND( numnam_ref ) ! Namelist namsbc_ssr in reference namelist : 162 167 READ ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) … … 169 174 170 175 IF(lwp) THEN !* control print 171 WRITE(numout,*)172 WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '173 WRITE(numout,*) '~~~~~~~ '174 176 WRITE(numout,*) ' Namelist namsbc_ssr :' 175 177 WRITE(numout,*) ' SST restoring term (Yes=1) nn_sstr = ', nn_sstr 176 178 WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K' 177 WRITE(numout,*) ' SSS damping term (Yes=1, salt flux)nn_sssr = ', nn_sssr179 WRITE(numout,*) ' SSS damping term (Yes=1, salt flux) nn_sssr = ', nn_sssr 178 180 WRITE(numout,*) ' (Yes=2, volume flux) ' 179 181 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r9168 r9169 1272 1272 CASE( np_teos10 ) !== polynomial TEOS-10 ==! 1273 1273 IF(lwp) WRITE(numout,*) 1274 IF(lwp) WRITE(numout,*) ' 1274 IF(lwp) WRITE(numout,*) ' ==>>> use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 1275 1275 ! 1276 1276 l_useCT = .TRUE. ! model temperature is Conservative temperature … … 1464 1464 ! 1465 1465 IF(lwp) WRITE(numout,*) 1466 IF(lwp) WRITE(numout,*) ' 1466 IF(lwp) WRITE(numout,*) ' ==>>> use of EOS-80 equation of state (pot. temp. and pract. salinity)' 1467 1467 ! 1468 1468 l_useCT = .FALSE. ! model temperature is Potential temperature … … 1655 1655 IF(lwp) THEN 1656 1656 WRITE(numout,*) 1657 WRITE(numout,*) ' use of simplified eos: rhd(dT=T-10,dS=S-35,Z) = ' 1658 WRITE(numout,*) ' [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 1659 WRITE(numout,*) 1660 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 1661 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0 1662 WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1 1663 WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2 1664 WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1 1665 WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2 1666 WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu 1667 WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization ' 1657 WRITE(numout,*) ' ==>>> use of simplified eos: ' 1658 WRITE(numout,*) ' rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT ' 1659 WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rau0' 1660 WRITE(numout,*) ' with the following coefficients :' 1661 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 1662 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0 1663 WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1 1664 WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2 1665 WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1 1666 WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2 1667 WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu 1668 WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization ' 1668 1669 ENDIF 1669 1670 l_useCT = .TRUE. ! Use conservative temperature … … 1682 1683 IF(lwp) THEN 1683 1684 IF( l_useCT ) THEN 1684 WRITE(numout,*) ' model uses Conservative Temperature' 1685 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 1685 WRITE(numout,*) 1686 WRITE(numout,*) ' ==>>> model uses Conservative Temperature' 1687 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 1686 1688 ELSE 1687 WRITE(numout,*) ' model does not use Conservative Temperature' 1689 WRITE(numout,*) 1690 WRITE(numout,*) ' ==>>> model does not use Conservative Temperature' 1688 1691 ENDIF 1689 1692 ENDIF 1690 1693 ! 1691 1694 IF(lwp) WRITE(numout,*) 1692 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 1693 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1694 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1695 IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp 1696 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1695 IF(lwp) WRITE(numout,*) ' Associated physical constant' 1696 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 1697 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1698 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1699 IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp 1700 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1697 1701 ! 1698 1702 END SUBROUTINE eos_init -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r9168 r9169 379 379 CASE( np_RGB , np_RGBc ) !== Red-Green-Blue light penetration ==! 380 380 ! 381 IF(lwp) WRITE(numout,*) ' R-G-B light penetration '381 IF(lwp) WRITE(numout,*) ' ==>>> R-G-B light penetration ' 382 382 ! 383 383 CALL trc_oce_rgb( rkrgb ) ! tabulated attenuation coef. … … 388 388 ! 389 389 IF( nqsr == np_RGBc ) THEN ! Chl data : set sf_chl structure 390 IF(lwp) WRITE(numout,*) ' 390 IF(lwp) WRITE(numout,*) ' ==>>> Chlorophyll read in a file' 391 391 ALLOCATE( sf_chl(1), STAT=ierror ) 392 392 IF( ierror > 0 ) THEN … … 400 400 ENDIF 401 401 IF( nqsr == np_RGB ) THEN ! constant Chl 402 IF(lwp) WRITE(numout,*) ' 402 IF(lwp) WRITE(numout,*) ' ==>>> Constant Chlorophyll concentration = 0.05' 403 403 ENDIF 404 404 ! 405 405 CASE( np_2BD ) !== 2 bands light penetration ==! 406 406 ! 407 IF(lwp) WRITE(numout,*) ' 2 bands light penetration'407 IF(lwp) WRITE(numout,*) ' ==>>> 2 bands light penetration' 408 408 ! 409 409 nksr = trc_oce_ext_lev( rn_si1, 100._wp ) ! level of light extinction … … 412 412 CASE( np_BIO ) !== BIO light penetration ==! 413 413 ! 414 IF(lwp) WRITE(numout,*) ' bio-model light penetration'414 IF(lwp) WRITE(numout,*) ' ==>>> bio-model light penetration' 415 415 IF( .NOT.lk_top ) CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' ) 416 416 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90
r9124 r9169 104 104 kperio = 0 ! GYRE configuration : closed domain 105 105 ! 106 WRITE(ldtxt(ii),*) ' ' ; ii = ii + 1107 WRITE(ldtxt(ii),*) ' Lateral b.c. of the global domain set to closed jperio = ', kperio ; ii = ii + 1106 WRITE(ldtxt(ii),*) ' ' ; ii = ii + 1 107 WRITE(ldtxt(ii),*) ' Lateral b.c. of the global domain set to closed jperio = ', kperio ; ii = ii + 1 108 108 ! 109 109 END SUBROUTINE usr_def_nam -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90
r9108 r9169 83 83 !!---------------------------------------------------------------------- 84 84 ! 85 IF(lwp) THEN 86 WRITE(numout,*) 87 WRITE(numout,*) 'zdf_phy_init: ocean vertical physics' 88 WRITE(numout,*) '~~~~~~~~~~~~' 89 ENDIF 90 ! 85 91 ! !== Namelist ==! 86 92 REWIND( numnam_ref ) ! Namelist namzdf in reference namelist : Vertical mixing parameters … … 94 100 ! 95 101 IF(lwp) THEN ! Parameter print 96 WRITE(numout,*)97 WRITE(numout,*) 'zdf_phy_init: vertical physics'98 WRITE(numout,*) '~~~~~~~~~~~~'99 102 WRITE(numout,*) ' Namelist namzdf : set vertical mixing mixing parameters' 100 103 WRITE(numout,*) ' vertical closure scheme' … … 163 166 IF(lwp) THEN 164 167 WRITE(numout,*) 165 IF ( ln_zdfnpc ) THEN ; WRITE(numout,*) ' convection: use non penetrative convective scheme'166 ELSEIF( ln_zdfevd ) THEN ; WRITE(numout,*) ' convection: use enhanced vertical diffusion scheme'167 ELSE ; WRITE(numout,*) ' convection: no specific scheme used'168 IF ( ln_zdfnpc ) THEN ; WRITE(numout,*) ' ==>>> convection: use non penetrative convective scheme' 169 ELSEIF( ln_zdfevd ) THEN ; WRITE(numout,*) ' ==>>> convection: use enhanced vertical diffusion scheme' 170 ELSE ; WRITE(numout,*) ' ==>>> convection: no specific scheme used' 168 171 ENDIF 169 172 ENDIF … … 171 174 IF(lwp) THEN !== Double Diffusion Mixing parameterization ==! (ddm) 172 175 WRITE(numout,*) 173 IF( ln_zdfddm ) THEN ; WRITE(numout,*) ' use double diffusive mixing: avs /= avt'174 ELSE ; WRITE(numout,*) ' No double diffusive mixing: avs = avt'176 IF( ln_zdfddm ) THEN ; WRITE(numout,*) ' ==>>> use double diffusive mixing: avs /= avt' 177 ELSE ; WRITE(numout,*) ' ==>>> No double diffusive mixing: avs = avt' 175 178 ENDIF 176 179 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r9104 r9169 678 678 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 679 679 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 680 WRITE(numout,*)681 680 IF( ln_drg ) THEN 681 WRITE(numout,*) 682 682 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' 683 683 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top)= ', r_z0_top … … 685 685 ENDIF 686 686 WRITE(numout,*) 687 WRITE(numout,*) 688 WRITE(numout,*) ' ==>> critical Richardson nb with your parameters ri_cri = ', ri_cri 687 WRITE(numout,*) ' ==>> critical Richardson nb with your parameters ri_cri = ', ri_cri 689 688 WRITE(numout,*) 690 689 ENDIF … … 693 692 rn_emin = 1.e-10_wp ! specific values of rn_emin & rmxl_min are used 694 693 rmxl_min = 1.e-03_wp ! associated avt minimum = molecular salt diffusivity (10^-9 m2/s) 695 IF(lwp) WRITE(numout,*) ' Internal wave-driven mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3'694 IF(lwp) WRITE(numout,*) ' ==>> Internal wave-driven mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3' 696 695 ELSE ! standard case : associated avt minimum = molecular viscosity (10^-6 m2/s) 697 696 rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) ) ! resulting minimum length to recover molecular viscosity 698 IF(lwp) WRITE(numout,*) ' minimum mixing length with your parameters rmxl_min = ', rmxl_min697 IF(lwp) WRITE(numout,*) ' ==>> minimum mixing length with your parameters rmxl_min = ', rmxl_min 699 698 ENDIF 700 699 ! … … 709 708 ! 710 709 IF( ln_mxl0 ) THEN 711 IF(lwp) WRITE(numout,*) ' use a surface mixing length = F(stress) : set rn_mxl0 = rmxl_min' 710 IF(lwp) WRITE(numout,*) 711 IF(lwp) WRITE(numout,*) ' ==>> use a surface mixing length = F(stress) : set rn_mxl0 = rmxl_min' 712 712 rn_mxl0 = rmxl_min 713 713 ENDIF … … 763 763 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl ) 764 764 ELSE ! start TKE from rest 765 IF(lwp) WRITE(numout,*) 765 766 IF(lwp) WRITE(numout,*) ' ==>> previous run without TKE scheme, set en to background values' 766 767 en (:,:,:) = rn_emin * wmask(:,:,:) … … 769 770 ENDIF 770 771 ELSE !* Start from rest 772 IF(lwp) WRITE(numout,*) 771 773 IF(lwp) WRITE(numout,*) ' ==>> start from rest: set en to the background value' 772 774 en (:,:,:) = rn_emin * wmask(:,:,:) … … 777 779 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 778 780 ! ! ------------------- 779 IF(lwp) WRITE(numout,*) '---- tke -rst ----'781 IF(lwp) WRITE(numout,*) '---- tke_rst ----' 780 782 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 781 783 CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r9168 r9169 395 395 WRITE(numout,*) ' NEMO team' 396 396 WRITE(numout,*) ' Ocean General Circulation Model' 397 WRITE(numout,*) ' NEMO version 3.7 (2016) '397 WRITE(numout,*) ' NEMO version 4.0 (2017) ' 398 398 WRITE(numout,*) 399 399 WRITE(numout,*) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
r9019 r9169 115 115 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 116 116 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 117 !118 117 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 119 118 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 120 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )119 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 121 120 ! 122 121 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints 123 122 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 124 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 125 123 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 126 124 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark 127 125 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 128 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )126 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 129 127 130 128 ! !--------------------------! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/sao_data.F90
r7646 r9169 39 39 NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq 40 40 !!---------------------------------------------------------------------- 41 IF(lwp) THEN 42 WRITE(numout,*) 43 WRITE(numout,*) 'sao_data_init : offline obs operator initialization' 44 WRITE(numout,*) '~~~~~~~~~~~~~' 45 ENDIF 41 46 42 47 ! Standard offline obs_oper initialisation 43 n_files = 0! number of files to cycle through44 sao_files(:) = ''! list of files to read in45 nn_sao_idx(:) = 0! list of indices inside each file46 nn_sao_freq = -1! input frequency in time steps48 n_files = 0 ! number of files to cycle through 49 sao_files(:) = '' ! list of files to read in 50 nn_sao_idx(:) = 0 ! list of indices inside each file 51 nn_sao_freq = -1 ! input frequency in time steps 47 52 48 53 ! Standard offline obs_oper settings 49 54 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark 50 55 READ ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 ) 51 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 52 ! 56 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 53 57 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark 54 58 READ ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 ) 55 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. )59 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 56 60 57 61 lmask(:) = .FALSE. ! count input files 58 WHERE (sao_files(:) /= '')lmask(:) = .TRUE.62 WHERE( sao_files(:) /= '' ) lmask(:) = .TRUE. 59 63 n_files = COUNT(lmask) 60 64 ! … … 64 68 ! 65 69 IF(lwp) THEN ! Print summary of settings 66 WRITE(numout,*)67 WRITE(numout,*) 'offline obs_oper : Initialization'68 WRITE(numout,*) '~~~~~~~~~~~~~~~~~'69 70 WRITE(numout,*) ' Namelist namsao : set stand alone obs_oper parameters' 70 71 DO jf = 1, n_files 71 WRITE(numout,'(1X,2A)') ' Input forecast file name forecastfile= ', TRIM(sao_files(jf))72 WRITE(numout,*) 'Input forecast file index forecastindex = ', nn_sao_idx(jf)72 WRITE(numout,'(1X,2A)') ' Input forecast file name forecastfile = ', TRIM(sao_files(jf)) 73 WRITE(numout,*) ' Input forecast file index forecastindex = ', nn_sao_idx(jf) 73 74 END DO 74 75 END IF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r9124 r9169 194 194 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints 195 195 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 196 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 197 ! 196 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 198 197 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 199 198 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 200 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )199 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 201 200 ! 202 201 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints 203 202 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 204 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 205 203 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 206 204 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark 207 205 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 208 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )206 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 209 207 210 208 ! !--------------------------! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r9161 r9169 4 4 !! Off-line : interpolation of the physical fields 5 5 !!====================================================================== 6 !! History : 7 !! NEMO 3.4 ! 2012-03 First version by S. Alderson 8 !! ! Heavily derived from Christian's dtadyn routine 9 !! ! in OFF_SRC 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! sbc_ssm_init : initialization, namelist read, and SAVEs control 14 !! sbc_ssm : Interpolation of the fields 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers variables 17 USE c1d ! 1D configuration: lk_c1d 18 USE dom_oce ! ocean domain: variables 19 USE zdf_oce ! ocean vertical physics: variables 20 USE sbc_oce ! surface module: variables 21 USE phycst ! physical constants 22 USE eosbn2 ! equation of state - Brunt Vaisala frequency 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE zpshde ! z-coord. with partial steps: horizontal derivatives 25 USE closea ! for ln_closea 6 !! History : 3.4 ! 2012-03 (S. Alderson) original code 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! sbc_ssm_init : initialization, namelist read, and SAVEs control 11 !! sbc_ssm : Interpolation of the fields 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers variables 14 USE c1d ! 1D configuration: lk_c1d 15 USE dom_oce ! ocean domain: variables 16 USE zdf_oce ! ocean vertical physics: variables 17 USE sbc_oce ! surface module: variables 18 USE phycst ! physical constants 19 USE eosbn2 ! equation of state - Brunt Vaisala frequency 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE zpshde ! z-coord. with partial steps: horizontal derivatives 22 USE closea ! for ln_closea 26 23 ! 27 USE in_out_manager 28 USE iom 29 USE lib_mpp 30 USE prtctl 31 USE fldread 32 USE timing 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O library 26 USE lib_mpp ! distributed memory computing library 27 USE prtctl ! print control 28 USE fldread ! read input fields 29 USE timing ! Timing 33 30 34 31 IMPLICIT NONE … … 38 35 PUBLIC sbc_ssm ! called by sbc 39 36 40 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 41 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 42 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 43 LOGICAL :: l_sasread !: Ice intilisation: read a file (.TRUE.) or anaytical initilaistion in namelist &namsbc_sas 44 LOGICAL :: l_initdone = .false. 37 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssm files 38 LOGICAL :: ln_3d_uve ! specify whether input velocity data is 3D 39 LOGICAL :: ln_read_frq ! specify whether we must read frq or not 40 41 LOGICAL :: l_sasread ! Ice intilisation: =T read a file ; =F anaytical initilaistion 42 LOGICAL :: l_initdone = .false. 45 43 INTEGER :: nfld_3d 46 44 INTEGER :: nfld_2d … … 162 160 !! *** ROUTINE sbc_ssm_init *** 163 161 !! 164 !! ** Purpose : Initialisation of the dynamical data 165 !! ** Method : - read the data namsbc_ssm namelist 166 !! 167 !! ** Action : - read parameters 162 !! ** Purpose : Initialisation of sea surface mean data 168 163 !!---------------------------------------------------------------------- 169 164 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code … … 175 170 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_3d ! array of namelist information on the fields to read 176 171 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 177 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 178 TYPE(FLD_N) :: sn_usp, sn_vsp 179 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 180 ! 181 NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 182 !!---------------------------------------------------------------------- 183 184 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 185 172 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 173 TYPE(FLD_N) :: sn_usp, sn_vsp 174 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 175 !! 176 NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq, & 177 & sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 178 !!---------------------------------------------------------------------- 179 ! 180 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 181 ! 182 IF(lwp) THEN 183 WRITE(numout,*) 184 WRITE(numout,*) 'sbc_ssm_init : sea surface mean data initialisation ' 185 WRITE(numout,*) '~~~~~~~~~~~~ ' 186 ENDIF 187 ! 186 188 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields 187 189 READ ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 188 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 189 190 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 190 191 REWIND( numnam_cfg ) ! Namelist namsbc_sas in configuration namelist : Input fields 191 192 READ ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 192 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp )193 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp ) 193 194 IF(lwm) WRITE ( numond, namsbc_sas ) 194 195 ! ! store namelist information in an array 196 ! ! Control print 197 IF(lwp) THEN 198 WRITE(numout,*) 199 WRITE(numout,*) 'sbc_sas : standalone surface scheme ' 200 WRITE(numout,*) '~~~~~~~~~~~ ' 195 ! 196 IF(lwp) THEN ! Control print 201 197 WRITE(numout,*) ' Namelist namsbc_sas' 202 WRITE(numout,*) ' Initialisation using an input file = ',l_sasread198 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 203 199 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 204 200 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 205 WRITE(numout,*)206 201 ENDIF 207 202 ! … … 210 205 ! 211 206 IF( ln_apr_dyn ) THEN 212 IF( lwp ) WRITE(numout,*) ' No atmospheric gradient needed with StandAlone Surface scheme'207 IF( lwp ) WRITE(numout,*) ' ==>>> No atmospheric gradient needed with StandAlone Surface scheme' 213 208 ln_apr_dyn = .FALSE. 214 209 ENDIF 215 210 IF( ln_rnf ) THEN 216 IF( lwp ) WRITE(numout,*) ' No runoff needed with StandAlone Surface scheme'211 IF( lwp ) WRITE(numout,*) ' ==>>> No runoff needed with StandAlone Surface scheme' 217 212 ln_rnf = .FALSE. 218 213 ENDIF 219 214 IF( ln_ssr ) THEN 220 IF( lwp ) WRITE(numout,*) ' No surface relaxation needed with StandAlone Surface scheme'215 IF( lwp ) WRITE(numout,*) ' ==>>> No surface relaxation needed with StandAlone Surface scheme' 221 216 ln_ssr = .FALSE. 222 217 ENDIF 223 218 IF( nn_fwb > 0 ) THEN 224 IF( lwp ) WRITE(numout,*) ' No freshwater budget adjustment needed with StandAlone Surface scheme'219 IF( lwp ) WRITE(numout,*) ' ==>>> No freshwater budget adjustment needed with StandAlone Surface scheme' 225 220 nn_fwb = 0 226 221 ENDIF 227 222 IF( ln_closea ) THEN 228 IF( lwp ) WRITE(numout,*) ' No closed seas adjustment needed with StandAlone Surface scheme'223 IF( lwp ) WRITE(numout,*) ' ==>>> No closed seas adjustment needed with StandAlone Surface scheme' 229 224 ln_closea = .false. 230 225 ENDIF 231 IF (l_sasread) THEN 232 ! 233 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 234 !! when we have other 3d arrays that we need to read in 235 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 236 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 237 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 238 !! and the rest of the logic should still work 239 ! 240 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 241 ! 242 IF( ln_3d_uve ) THEN 243 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 244 nfld_3d = 2 + COUNT( (/.NOT.ln_linssh/) ) ! number of 3D fields to read 245 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 246 ELSE 247 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) ! update 2D fields index 248 nfld_3d = 0 ! no 3D fields to read 249 nfld_2d = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 250 ENDIF 251 252 IF( nfld_3d > 0 ) THEN 253 ALLOCATE( slf_3d(nfld_3d), STAT=ierr ) ! set slf structure 254 IF( ierr > 0 ) THEN 255 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 256 ENDIF 257 slf_3d(jf_usp) = sn_usp 258 slf_3d(jf_vsp) = sn_vsp 259 IF( .NOT.ln_linssh ) slf_3d(jf_e3t) = sn_e3t 260 ENDIF 261 262 IF( nfld_2d > 0 ) THEN 263 ALLOCATE( slf_2d(nfld_2d), STAT=ierr ) ! set slf structure 264 IF( ierr > 0 ) THEN 265 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' ) ; RETURN 266 ENDIF 267 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 268 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 269 IF( .NOT. ln_3d_uve ) THEN 270 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 271 IF( .NOT.ln_linssh ) slf_2d(jf_e3t) = sn_e3t 272 ENDIF 273 ENDIF 274 ! 275 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 276 IF( nfld_3d > 0 ) THEN 277 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure 278 IF( ierr > 0 ) THEN 279 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' ) ; RETURN 280 ENDIF 281 DO ifpr = 1, nfld_3d 282 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 283 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 284 IF( ierr0 + ierr1 > 0 ) THEN 285 CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' ) ; RETURN 286 ENDIF 287 END DO 288 ! ! fill sf with slf_i and control print 289 CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 290 ENDIF 291 292 IF( nfld_2d > 0 ) THEN 293 ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr ) ! set sf structure 294 IF( ierr > 0 ) THEN 295 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' ) ; RETURN 296 ENDIF 297 DO ifpr = 1, nfld_2d 298 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 299 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 300 IF( ierr0 + ierr1 > 0 ) THEN 301 CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' ) ; RETURN 302 ENDIF 303 END DO 304 ! 305 CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 306 ENDIF 307 ! 308 ! finally tidy up 309 310 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 311 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 312 313 ENDIF 314 226 227 ! 228 IF( l_sasread ) THEN ! store namelist information in an array 229 ! 230 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 231 !! when we have other 3d arrays that we need to read in 232 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 233 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 234 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 235 !! and the rest of the logic should still work 236 ! 237 jf_tem = 1 ; jf_ssh = 3 ! default 2D fields index 238 jf_sal = 2 ; jf_frq = 4 ! 239 ! 240 IF( ln_3d_uve ) THEN 241 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 242 nfld_3d = 2 + COUNT( (/.NOT.ln_linssh/) ) ! number of 3D fields to read 243 nfld_2d = 3 + COUNT( ( /ln_read_frq/) ) ! number of 2D fields to read 244 ELSE 245 jf_usp = 4 ; jf_e3t = 6 ! update 2D fields index 246 jf_vsp = 5 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) 247 ! 248 nfld_3d = 0 ! no 3D fields to read 249 nfld_2d = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 250 ENDIF 251 ! 252 IF( nfld_3d > 0 ) THEN 253 ALLOCATE( slf_3d(nfld_3d), STAT=ierr ) ! set slf structure 254 IF( ierr > 0 ) THEN 255 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 256 ENDIF 257 slf_3d(jf_usp) = sn_usp 258 slf_3d(jf_vsp) = sn_vsp 259 IF( .NOT.ln_linssh ) slf_3d(jf_e3t) = sn_e3t 260 ENDIF 261 ! 262 IF( nfld_2d > 0 ) THEN 263 ALLOCATE( slf_2d(nfld_2d), STAT=ierr ) ! set slf structure 264 IF( ierr > 0 ) THEN 265 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' ) ; RETURN 266 ENDIF 267 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 268 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 269 IF( .NOT. ln_3d_uve ) THEN 270 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 271 IF( .NOT.ln_linssh ) slf_2d(jf_e3t) = sn_e3t 272 ENDIF 273 ENDIF 274 ! 275 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 276 IF( nfld_3d > 0 ) THEN 277 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure 278 IF( ierr > 0 ) THEN 279 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' ) ; RETURN 280 ENDIF 281 DO ifpr = 1, nfld_3d 282 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 283 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 284 IF( ierr0 + ierr1 > 0 ) THEN 285 CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' ) ; RETURN 286 ENDIF 287 END DO 288 ! ! fill sf with slf_i and control print 289 CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 290 ENDIF 291 ! 292 IF( nfld_2d > 0 ) THEN 293 ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr ) ! set sf structure 294 IF( ierr > 0 ) THEN 295 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' ) ; RETURN 296 ENDIF 297 DO ifpr = 1, nfld_2d 298 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 299 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 300 IF( ierr0 + ierr1 > 0 ) THEN 301 CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' ) ; RETURN 302 ENDIF 303 END DO 304 ! 305 CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 306 ENDIF 307 ! 308 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 309 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 310 ! 311 ENDIF 312 ! 315 313 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in iceistate 316 314 l_initdone = .TRUE. -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90
r9119 r9169 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) 7 7 !!---------------------------------------------------------------------- 8 !! trc_nam_age : AGE 8 !! trc_nam_age : AGE tracer initialisation 9 9 !!---------------------------------------------------------------------- 10 10 USE oce_trc ! Ocean variables … … 22 22 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 23 23 !!---------------------------------------------------------------------- 24 25 24 CONTAINS 26 25 … … 33 32 !! ** input : Namelist namage 34 33 !!---------------------------------------------------------------------- 35 INTEGER :: ios ! Local integer output status for namelist read34 INTEGER :: ios ! Local integer 36 35 !! 37 36 NAMELIST/namage/ rn_age_depth, rn_age_kill_rate 38 37 !!---------------------------------------------------------------------- 38 ! 39 IF(lwp) THEN 40 WRITE(numout,*) 41 WRITE(numout,*) ' Sea Age Tracer' 42 WRITE(numout,*) 43 WRITE(numout,*) 'trc_nam_age : Read namage namelist for Age passive tracer' 44 WRITE(numout,*) '~~~~~~~~~~~' 45 ENDIF 46 39 47 ! Variable setting 40 48 ctrcnm (jp_age) = 'Age' … … 48 56 REWIND( numnat_ref ) ! Namelist namagedate in reference namelist : AGE parameters 49 57 READ ( numnat_ref, namage, IOSTAT = ios, ERR = 901) 50 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in reference namelist', lwp ) 51 58 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in reference namelist', lwp ) 52 59 REWIND( numnat_cfg ) ! Namelist namagedate in configuration namelist : AGE parameters 53 60 READ ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 ) 54 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namage in configuration namelist', lwp )61 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namage in configuration namelist', lwp ) 55 62 IF(lwm) WRITE ( numont, namage ) 56 63 ! 57 64 IF(lwp) THEN ! control print 58 WRITE(numout,*) ' ' 59 WRITE(numout,*) ' Sea Age Tracer' 60 WRITE(numout,*) 61 WRITE(numout,*) ' trc_nam_age: Read namage, namelist for Age passive tracer' 62 WRITE(numout,*) ' ~~~~~~~' 63 WRITE(numout,*) ' depth over which age tracer reset to zero rn_age_depth = ', & 64 & rn_age_depth 65 WRITE(numout,*) ' recip of relax. timescale (s) for age tracer shallower than age_depth rn_age_kill_rate = ', & 66 & rn_age_kill_rate 67 WRITE(numout,*) '' 65 WRITE(numout,*) ' Namelist : namage' 66 WRITE(numout,*) ' depth over which age tracer reset to zero rn_age_depth = ', rn_age_depth 67 WRITE(numout,*) ' recip of relaxation timescale rn_age_kill_rate = ', rn_age_kill_rate, '[s]' 68 WRITE(numout,*) ' (for age tracer shallower than age_depth) ' 68 69 ENDIF 69 70 70 ! 71 71 END SUBROUTINE trc_nam_age -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/C14/trcnam_c14.F90
r7124 r9169 37 37 !! ** input : Namelist namelist_c14 38 38 !!---------------------------------------------------------------------- 39 INTEGER :: ios ! Local integer output status for namelist read39 INTEGER :: ios ! Local integer 40 40 !! 41 41 NAMELIST/namc14_typ/ kc14typ,rc14at, pco2at, rc14init ! type of C14 tracer, default values of C14/C, pco2, & ocean r14 42 42 NAMELIST/namc14_sbc/ ln_chemh, xkwind, xdicsur ! chem enh, wind coeff, ref DIC 43 NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg ! for transient exps; atm forcing43 NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg ! for transient exps; atm forcing 44 44 !!------------------------------------------------------------------- 45 ! 46 IF(lwp) THEN 47 WRITE(numout,*) ' ' 48 WRITE(numout,*) ' Radiocarbon C14' 49 WRITE(numout,*) ' ' 50 WRITE(numout,*) ' trc_nam_c14 : Read C14 namelists' 51 WRITE(numout,*) ' ~~~~~~~~~~~' 52 ENDIF 53 ! 45 54 ! Variable setting 46 55 ctrcnm (jp_c14) = 'RC14' … … 54 63 REWIND( numtrc_ref ) ! Namelist namc14_typ in reference namelist : 55 64 READ ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901) 56 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp ) 57 65 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp ) 58 66 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist 59 67 READ ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902) 60 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp )68 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp ) 61 69 IF(lwm) WRITE ( numonr, namc14_typ ) 62 70 ! 63 71 IF(lwp) THEN ! control print 64 WRITE(numout,*) ' ' 65 WRITE(numout,*) ' Radiocarbon C14' 66 WRITE(numout,*) ' ' 67 WRITE(numout,*) ' Namelist namc14_typ' 72 WRITE(numout,*) ' Namelist : namc14_typ' 73 WRITE(numout,*) ' Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ 74 WRITE(numout,*) ' Default value for atmospheric C14/C (used for equil run) rc14at = ', rc14at 75 WRITE(numout,*) ' Default value for atmospheric pcO2 [atm] (used for equil run) pco2at = ', pco2at 76 WRITE(numout,*) ' Default value for initial C14/C in the ocean (used for equil run) rc14init= ', rc14init 68 77 WRITE(numout,*) 69 WRITE(numout,*) ' Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ70 WRITE(numout,*) ' Default value for atmospheric C14/C (used for equil run) rc14at = ', rc14at71 WRITE(numout,*) ' Default value for atmospheric pcO2 [atm] (used for equil run) pco2at = ', pco2at72 WRITE(numout,*) ' Default value for initial C14/C in the ocean (used for equil run) rc14init= ', rc14init73 WRITE(numout,*) ' '74 78 ENDIF 75 79 76 80 REWIND( numtrc_ref ) ! Namelist namc14_typ in reference namelist : 77 81 READ ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903) 78 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp ) 79 82 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp ) 80 83 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist 81 84 READ ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904) 82 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp )83 IF(lwm) WRITE 84 85 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp ) 86 IF(lwm) WRITE( numonr, namc14_sbc ) 87 ! 85 88 IF(lwp) THEN ! control print 86 WRITE(numout,*) ' Namelist namc14_sbc' 89 WRITE(numout,*) ' Namelist namc14_sbc' 90 WRITE(numout,*) ' Chemical enhancement in piston velocity ln_chemh = ', ln_chemh 91 WRITE(numout,*) ' Coefficient for gas exchange velocity xkwind = ', xkwind 92 WRITE(numout,*) ' Reference DIC concentration (mol/m3) xdicsur = ', xdicsur 87 93 WRITE(numout,*) 88 WRITE(numout,*) ' Chemical enhancement in piston velocity ln_chemh = ', ln_chemh89 WRITE(numout,*) ' Coefficient for gas exchange velocity xkwind = ', xkwind90 WRITE(numout,*) ' Reference DIC concentration (mol/m3) xdicsur = ', xdicsur91 WRITE(numout,*) ' '92 94 ENDIF 93 95 94 96 REWIND( numtrc_ref ) ! Namelist namc14_typ in reference namelist : 95 97 READ ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905) 96 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp ) 97 98 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp ) 98 99 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist 99 100 READ ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906) 100 906 IF( ios /= 0 )CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp )101 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp ) 101 102 IF(lwm) WRITE ( numonr, namc14_fcg ) 102 103 ! 103 104 IF(lwp) THEN ! control print 104 WRITE(numout,*) ' Namelist namc14_fcg' 105 WRITE(numout,*) 106 WRITE(numout,*) ' Atmospheric co2 file ( bomb ) cfileco2 = ', TRIM( cfileco2 ) 107 WRITE(numout,*) ' Atmospheric c14 file ( bomb ) cfilec14 = ', TRIM( cfilec14 ) 108 WRITE(numout,*) ' Starting year of experiment tyrc14_beg = ', tyrc14_beg 109 WRITE(numout,*) ' ' 105 WRITE(numout,*) ' Namelist namc14_fcg' 106 WRITE(numout,*) ' Atmospheric co2 file ( bomb ) cfileco2 = ', TRIM( cfileco2 ) 107 WRITE(numout,*) ' Atmospheric c14 file ( bomb ) cfilec14 = ', TRIM( cfilec14 ) 108 WRITE(numout,*) ' Starting year of experiment tyrc14_beg = ', tyrc14_beg 110 109 ENDIF 111 110 112 111 ! 113 IF( kc14typ == 2 ) tyrc14_beg = 1950._wp - tyrc14_beg! BP to AD dates112 IF( kc14typ == 2 ) tyrc14_beg = 1950._wp - tyrc14_beg ! BP to AD dates 114 113 ! set units 115 114 rlam14 = LOG(2._wp) / 5730._wp / rsiyea ! C14 decay rate: yr^-1 --> s^-1 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r7646 r9169 24 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 25 !!---------------------------------------------------------------------- 26 27 26 CONTAINS 28 27 … … 38 37 !! ** input : Namelist namcfc 39 38 !!---------------------------------------------------------------------- 40 INTEGER :: ios ! Local integer output status for namelist read41 INTEGER :: jl, jn39 INTEGER :: ios ! Local integer 40 INTEGER :: jl, jn 42 41 !! 43 42 NAMELIST/namcfc/ ndate_beg, nyear_res, clname 44 43 !!---------------------------------------------------------------------- 44 ! 45 IF(lwp) THEN 46 WRITE(numout,*) ' ' 47 WRITE(numout,*) ' CFCs' 48 WRITE(numout,*) ' ' 49 WRITE(numout,*) ' trc_nam_cfc : Read namcfc namelist for CFC chemical model' 50 WRITE(numout,*) ' ~~~~~~~~~~~' 51 ENDIF 52 ! 53 REWIND( numtrc_ref ) ! Namelist namcfcdate in reference namelist : CFC parameters 54 READ ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 55 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 56 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist : CFC parameters 57 READ ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 58 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 59 IF(lwm) WRITE( numonr, namcfc ) 60 IF(lwm) CALL FLUSH ( numonr ) ! flush output namelist CFC 61 62 IF(lwp) THEN ! control print 63 WRITE(numout,*) ' Namelist : namcfc' 64 WRITE(numout,*) ' initial calendar date (aammjj) for CFC ndate_beg = ', ndate_beg, '[yymmdd]' 65 WRITE(numout,*) ' restoring time constant (year) nyear_res = ', nyear_res 66 ENDIF 67 nyear_beg = ndate_beg / 10000 68 IF(lwp) WRITE(numout,*) ' associated initial year (aa) nyear_beg = ', nyear_beg, '[yy]' 45 69 ! 46 70 jn = jp_cfc0 - 1 … … 79 103 ENDIF 80 104 ! 81 REWIND( numtrc_ref ) ! Namelist namcfcdate in reference namelist : CFC parameters82 READ ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901)83 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp )84 85 REWIND( numtrc_cfg ) ! Namelist namcfcdate in configuration namelist : CFC parameters86 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 )89 90 IF(lwp) THEN ! control print91 WRITE(numout,*) ' '92 WRITE(numout,*) ' CFCs'93 WRITE(numout,*) ' '94 WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model'95 WRITE(numout,*) ' ~~~~~~~'96 WRITE(numout,*) ' initial calendar date (aammjj) for CFC ndate_beg = ', ndate_beg97 WRITE(numout,*) ' restoring time constant (year) nyear_res = ', nyear_res98 ENDIF99 nyear_beg = ndate_beg / 10000100 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg101 !102 IF(lwm) CALL FLUSH ( numonr ) ! flush output namelist CFC103 104 105 END SUBROUTINE trc_nam_cfc 105 106 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r9125 r9169 13 13 USE oce_trc ! 14 14 USE trc ! 15 USE sms_pisces 16 USE p2zopt 15 USE sms_pisces ! 16 USE p2zopt ! 17 USE trd_oce ! 18 USE trdtrc ! 19 ! 17 20 USE lbclnk ! 18 21 USE prtctl_trc ! Print control for debbuging 19 USE trd_oce 20 USE trdtrc 21 USE iom 22 USE iom ! 22 23 23 24 IMPLICIT NONE … … 83 84 !! 84 85 !!--------------------------------------------------------------------- 85 !!86 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index 87 ! !87 ! 88 88 INTEGER :: ji, jj, jk, jl 89 89 REAL(wp) :: zdet, zzoo, zphy, zno3, znh4, zdom ! now concentrations … … 96 96 REAL(wp) :: znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 97 97 REAL(wp) :: ze3t 98 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::zw2d99 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zw3d98 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw2d 99 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zw3d 100 100 CHARACTER (len=25) :: charout 101 101 !!--------------------------------------------------------------------- … … 103 103 IF( ln_timing ) CALL timing_start('p2z_bio') 104 104 ! 105 IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) )105 IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) ) 106 106 107 107 IF( kt == nittrc000 ) THEN … … 113 113 xksi(:,:) = 0.e0 ! zooplakton closure ( fbod) 114 114 IF( lk_iomput ) THEN 115 zw2d (:,:,:) = 0. e0116 zw3d(:,:,:,:) = 0. e0115 zw2d (:,:,:) = 0._wp 116 zw3d(:,:,:,:) = 0._wp 117 117 ENDIF 118 118 … … 311 311 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 312 312 ! 313 IF( lk_iomput ) THEN 314 ! convert fluxes in per day 313 IF( lk_iomput ) THEN ! convert fluxes in per day 315 314 ze3t = e3t_n(ji,jj,jk) * 86400._wp 316 315 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t … … 335 334 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 336 335 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 337 338 336 ! 337 ENDIF 339 338 END DO 340 339 END DO 341 340 END DO 342 341 ! 343 342 IF( lk_iomput ) THEN 344 CALL lbc_lnk( zw2d(:,:,:),'T', 1. )345 CALL lbc_lnk_multi( zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. )346 ! Save diagnostics347 CALL iom_put( "TNO3PHY", zw2d(:,:,1) )348 CALL iom_put( "TNH4PHY", zw2d(:,:,2) )349 CALL iom_put( "TPHYDOM", zw2d(:,:,3) )350 CALL iom_put( "TPHYNH4", zw2d(:,:,4) )351 CALL iom_put( "TPHYZOO", zw2d(:,:,5) )352 CALL iom_put( "TPHYDET", zw2d(:,:,6) )353 CALL iom_put( "TDETZOO", zw2d(:,:,7) )354 CALL iom_put( "TZOODET", zw2d(:,:,8) )355 CALL iom_put( "TZOOBOD", zw2d(:,:,9) )356 CALL iom_put( "TZOONH4", zw2d(:,:,10) )357 CALL iom_put( "TZOODOM", zw2d(:,:,11) )358 CALL iom_put( "TNH4NO3", zw2d(:,:,12) )359 CALL iom_put( "TDOMNH4", zw2d(:,:,13) )360 CALL iom_put( "TDETNH4", zw2d(:,:,14) )361 CALL iom_put( "TPHYTOT", zw2d(:,:,15) )362 CALL iom_put( "TZOOTOT", zw2d(:,:,16) )343 CALL lbc_lnk( zw2d(:,:,:),'T', 1. ) 344 CALL lbc_lnk_multi( zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 345 ! Save diagnostics 346 CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 347 CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 348 CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 349 CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 350 CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 351 CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 352 CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 353 CALL iom_put( "TZOODET", zw2d(:,:,8) ) 354 CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 355 CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 356 CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 357 CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 358 CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 359 CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 360 CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 361 CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 363 362 ! 364 CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) )365 CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) )366 CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) )363 CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 364 CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 365 CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 367 366 ! 368 367 ENDIF … … 374 373 ENDIF 375 374 ! 376 IF( lk_iomput ) DEALLOCATE( zw2d, zw3d )375 IF( lk_iomput ) DEALLOCATE( zw2d, zw3d ) 377 376 ! 378 377 IF( ln_timing ) CALL timing_stop('p2z_bio') … … 390 389 !! 391 390 !!---------------------------------------------------------------------- 391 INTEGER :: ios ! Local integer 392 !! 392 393 NAMELIST/namlobphy/ tmumax, rgamma, fphylab, tmminp, aki 393 394 NAMELIST/namlobnut/ akno3, aknh4, taunn, psinut 394 395 NAMELIST/namlobzoo/ rppz, taus, aks, rpnaz, rdnaz, tauzn, fzoolab, fdbod, tmminz 395 NAMELIST/namlobdet/ 396 NAMELIST/namlobdet/ taudn, fdetlab 396 397 NAMELIST/namlobdom/ taudomn 397 INTEGER :: ios ! Local integer output status for namelist read398 398 !!---------------------------------------------------------------------- 399 399 ! 400 IF(lwp) WRITE(numout,*) 401 IF(lwp) WRITE(numout,*) ' p2z_bio_init : LOBSTER bio-model initialization' 402 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~' 403 ! 400 404 REWIND( numnatp_ref ) ! Namelist namlobphy in reference namelist : Lobster biological parameters 401 405 READ ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901) 402 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp ) 403 406 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp ) 404 407 REWIND( numnatp_cfg ) ! Namelist namlobphy in configuration namelist : Lobster biological parameters 405 408 READ ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 ) 406 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp )409 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp ) 407 410 IF(lwm) WRITE ( numonp, namlobphy ) 408 411 ! 409 412 IF(lwp) THEN 410 WRITE(numout,*) ' Namelist namlobphy' 411 WRITE(numout,*) ' phyto max growth rate tmumax =', 86400 * tmumax, ' d' 412 WRITE(numout,*) ' phytoplankton exudation fraction rgamma =', rgamma 413 WRITE(numout,*) ' NH4 fraction of phytoplankton exsudation fphylab =', fphylab 414 WRITE(numout,*) ' minimal phyto mortality rate tmminp =', 86400 * tmminp 415 WRITE(numout,*) ' light hlaf saturation constant aki =', aki 416 WRITE(numout,*) ' ' 413 WRITE(numout,*) ' Namelist namlobphy' 414 WRITE(numout,*) ' phyto max growth rate tmumax =', 86400 * tmumax, ' d' 415 WRITE(numout,*) ' phytoplankton exudation fraction rgamma =', rgamma 416 WRITE(numout,*) ' NH4 fraction of phytoplankton exsudation fphylab =', fphylab 417 WRITE(numout,*) ' minimal phyto mortality rate tmminp =', 86400 * tmminp 418 WRITE(numout,*) ' light hlaf saturation constant aki =', aki 417 419 ENDIF 418 420 419 421 REWIND( numnatp_ref ) ! Namelist namlobnut in reference namelist : Lobster nutriments parameters 420 422 READ ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903) 421 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp ) 422 423 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp ) 423 424 REWIND( numnatp_cfg ) ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters 424 425 READ ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 ) 425 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp )426 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp ) 426 427 IF(lwm) WRITE ( numonp, namlobnut ) 427 428 428 429 IF(lwp) THEN 429 WRITE(numout,*) ' Namelist namlobnut'430 WRITE(numout,*) ' half-saturation nutrient for no3 uptake akno3 =', akno3431 WRITE(numout,*) ' half-saturation nutrient for nh4 uptake aknh4 =', aknh4432 WRITE(numout,*) ' nitrification rate taunn =', taunn433 WRITE(numout,*) ' inhibition of no3 uptake by nh4 psinut =', psinut434 WRITE(numout,*) ' '430 WRITE(numout,*) 431 WRITE(numout,*) ' Namelist namlobnut' 432 WRITE(numout,*) ' half-saturation nutrient for no3 uptake akno3 =', akno3 433 WRITE(numout,*) ' half-saturation nutrient for nh4 uptake aknh4 =', aknh4 434 WRITE(numout,*) ' nitrification rate taunn =', taunn 435 WRITE(numout,*) ' inhibition of no3 uptake by nh4 psinut =', psinut 435 436 ENDIF 436 437 437 438 REWIND( numnatp_ref ) ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters 438 439 READ ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905) 439 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp ) 440 440 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp ) 441 441 REWIND( numnatp_cfg ) ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters 442 442 READ ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 ) 443 906 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp )443 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp ) 444 444 IF(lwm) WRITE ( numonp, namlobzoo ) 445 445 446 446 IF(lwp) THEN 447 WRITE(numout,*) ' Namelist namlobzoo'448 WRITE(numout,*) ' zoo preference for phyto rppz =', rppz449 WRITE(numout,*) ' maximal zoo grazing rate taus =', 86400 * taus, ' d'450 WRITE(numout,*) ' half saturation constant for zoo food aks =', aks451 WRITE(numout,*) ' non-assimilated phyto by zoo rpnaz =', rpnaz452 WRITE(numout,*) ' non-assimilated detritus by zoo rdnaz =', rdnaz453 WRITE(numout,*) ' zoo specific excretion rate tauzn =', 86400 * tauzn454 WRITE(numout,*) ' minimal zoo mortality rate tmminz =', 86400 * tmminz455 WRITE(numout,*) ' NH4 fraction of zooplankton excretion fzoolab =', fzoolab456 WRITE(numout,*) ' Zooplankton mortality fraction that goes to detritus fdbod =', fdbod457 WRITE(numout,*) ' '447 WRITE(numout,*) 448 WRITE(numout,*) ' Namelist namlobzoo' 449 WRITE(numout,*) ' zoo preference for phyto rppz =', rppz 450 WRITE(numout,*) ' maximal zoo grazing rate taus =', 86400 * taus, ' d' 451 WRITE(numout,*) ' half saturation constant for zoo food aks =', aks 452 WRITE(numout,*) ' non-assimilated phyto by zoo rpnaz =', rpnaz 453 WRITE(numout,*) ' non-assimilated detritus by zoo rdnaz =', rdnaz 454 WRITE(numout,*) ' zoo specific excretion rate tauzn =', 86400 * tauzn 455 WRITE(numout,*) ' minimal zoo mortality rate tmminz =', 86400 * tmminz 456 WRITE(numout,*) ' NH4 fraction of zooplankton excretion fzoolab =', fzoolab 457 WRITE(numout,*) ' Zooplankton mortality fraction that goes to detritus fdbod =', fdbod 458 458 ENDIF 459 459 460 460 REWIND( numnatp_ref ) ! Namelist namlobdet in reference namelist : Lobster detritus parameters 461 461 READ ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907) 462 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp ) 463 462 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp ) 464 463 REWIND( numnatp_cfg ) ! Namelist namlobdet in configuration namelist : Lobster detritus parameters 465 464 READ ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 ) 466 908 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp )465 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp ) 467 466 IF(lwm) WRITE ( numonp, namlobdet ) 468 467 469 468 IF(lwp) THEN 470 WRITE(numout,*) ' Namelist namlobdet'471 WRITE(numout,*) ' detrital breakdown rate taudn =', 86400 * taudn , ' d'472 WRITE(numout,*) ' NH4 fraction of detritus dissolution fdetlab =', fdetlab473 WRITE(numout,*) ' '469 WRITE(numout,*) 470 WRITE(numout,*) ' Namelist namlobdet' 471 WRITE(numout,*) ' detrital breakdown rate taudn =', 86400 * taudn , ' d' 472 WRITE(numout,*) ' NH4 fraction of detritus dissolution fdetlab =', fdetlab 474 473 ENDIF 475 474 476 475 REWIND( numnatp_ref ) ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate 477 476 READ ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909) 478 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp ) 479 477 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp ) 480 478 REWIND( numnatp_cfg ) ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate 481 479 READ ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 ) 482 910 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp )480 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp ) 483 481 IF(lwm) WRITE ( numonp, namlobdom ) 484 482 485 483 IF(lwp) THEN 486 WRITE(numout,*) ' Namelist namlobdom'487 WRITE(numout,*) ' DOM breakdown rate taudomn =', 86400 * taudn , ' d'488 WRITE(numout,*) ' '484 WRITE(numout,*) 485 WRITE(numout,*) ' Namelist namlobdom' 486 WRITE(numout,*) ' DOM breakdown rate taudomn =', 86400 * taudn , ' d' 489 487 ENDIF 490 488 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r9125 r9169 11 11 !!---------------------------------------------------------------------- 12 12 USE oce_trc ! 13 USE trc 14 USE sms_pisces 15 USE lbclnk 16 USE trd_oce 17 USE trdtrc 18 USE iom 13 USE trd_oce ! 14 USE trdtrc ! 15 USE trc ! 16 USE sms_pisces ! 17 ! 18 USE lbclnk ! 19 USE iom ! 19 20 USE prtctl_trc ! Print control for debbuging 20 21 … … 26 27 27 28 REAL(wp), PUBLIC :: sedlam !: time coefficient of POC remineralization in sediments 28 REAL(wp), PUBLIC :: sedlostpoc ! mass of POC lost in sediments29 REAL(wp), PUBLIC :: vsed ! detritus sedimentation speed [m/s]30 REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile29 REAL(wp), PUBLIC :: sedlostpoc !: mass of POC lost in sediments 30 REAL(wp), PUBLIC :: vsed !: detritus sedimentation speed [m/s] 31 REAL(wp), PUBLIC :: xhr !: coeff for martin''s remineralisation profile 31 32 32 33 !!---------------------------------------------------------------------- … … 126 127 !! 127 128 !!---------------------------------------------------------------------- 129 INTEGER :: ios ! Local integer 130 !! 128 131 NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr 129 INTEGER :: ios ! Local integer output status for namelist read130 132 !!---------------------------------------------------------------------- 133 ! 131 134 REWIND( numnatp_ref ) ! Namelist namlobsed in reference namelist : Lobster sediments 132 135 READ ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901) 133 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp ) 134 136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp ) 135 137 REWIND( numnatp_cfg ) ! Namelist namlobsed in configuration namelist : Lobster sediments 136 138 READ ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 ) 137 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp ) 138 140 IF(lwm) WRITE ( numonp, namlobsed ) 139 141 ! 140 142 IF(lwp) THEN 141 WRITE(numout,*) ' Namelist namlobsed'142 WRITE(numout,*) ' time coeff of POC in sedimentssedlam =', sedlam143 WRITE(numout,*) ' Sediment geol loss for POCsedlostpoc=', sedlostpoc144 WRITE(numout,*) ' detritus sedimentation speedvsed =', 86400 * vsed , ' d'145 WRITE(numout,*) ' coeff for martin''s remineralistionxhr =', xhr143 WRITE(numout,*) ' Namelist namlobsed' 144 WRITE(numout,*) ' time coeff of POC in sediments sedlam =', sedlam 145 WRITE(numout,*) ' Sediment geol loss for POC sedlostpoc=', sedlostpoc 146 WRITE(numout,*) ' detritus sedimentation speed vsed =', 86400 * vsed , ' d' 147 WRITE(numout,*) ' coeff for martin''s remineralistion xhr =', xhr 146 148 WRITE(numout,*) ' ' 147 149 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r9125 r9169 7 7 !! 3.6 ! 2015-05 (O. Aumont) PISCES quota 8 8 !!---------------------------------------------------------------------- 9 !! p4z_fechem : 10 !! p4z_fechem_init : 11 !! p4z_fechem_alloc : 9 !! p4z_fechem : Compute remineralization/scavenging of iron 10 !! p4z_fechem_init : Initialisation of parameters for remineralisation 11 !! p4z_fechem_alloc : Allocate remineralisation variables 12 12 !!---------------------------------------------------------------------- 13 USE oce_trc ! 14 USE trc ! 15 USE sms_pisces ! 16 USE p4zche ! 17 USE p4zsbc ! 18 USE prtctl_trc ! 19 USE iom ! 13 USE oce_trc ! shared variables between ocean and passive tracers 14 USE trc ! passive tracers common variables 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p4zche ! chemical model 17 USE p4zsbc ! Boundary conditions from sediments 18 USE prtctl_trc ! print control for debugging 19 USE iom ! I/O manager 20 20 21 21 IMPLICIT NONE 22 22 PRIVATE 23 23 24 PUBLIC p4z_fechem ! called in p4zbio.F90 25 PUBLIC p4z_fechem_init ! called in trcsms_pisces.F90 26 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 36 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 24 PUBLIC p4z_fechem ! called in p4zbio.F90 25 PUBLIC p4z_fechem_init ! called in trcsms_pisces.F90 26 27 LOGICAL :: ln_fechem !: boolean for complex iron chemistry following Tagliabue and voelker 28 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker 29 LOGICAL :: ln_fecolloid !: boolean for variable colloidal fraction 30 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron 31 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust 32 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 33 REAL(wp), PUBLIC :: kfep !: rate constant for nanoparticle formation 34 35 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth !!gm <<<== DOCTOR names SVP !!! 37 36 38 37 !!---------------------------------------------------------------------- … … 56 55 !! and one particulate form (ln_fechem) 57 56 !!--------------------------------------------------------------------- 58 ! 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step 57 INTEGER, INTENT(in) :: kt, knt ! ocean time step 60 58 ! 61 59 INTEGER :: ji, jj, jk, jic, jn … … 67 65 REAL(wp) :: zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2 68 66 REAL(wp) :: zrum, zcodel, zargu, zlight 69 REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand70 REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za271 REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq272 REAL(wp) :: ztfe, zoxy, zhplus73 REAL(wp) :: zaggliga, zaggligb74 REAL(wp) :: dissol, zligco67 REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 68 REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 69 REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 70 REAL(wp) :: ztfe, zoxy, zhplus 71 REAL(wp) :: zaggliga, zaggligb 72 REAL(wp) :: dissol, zligco 75 73 CHARACTER (len=25) :: charout 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, precip, zFeL177 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zFeL2, zTL2, zFe2, zFeP78 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zstrn, zstrn274 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, precip, zFeL1 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zFeL2, zTL2, zFe2, zFeP 76 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zstrn, zstrn2 79 77 !!--------------------------------------------------------------------- 80 78 ! … … 384 382 NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep 385 383 !!---------------------------------------------------------------------- 386 387 REWIND( numnatp_ref ) ! Namelist nampisfer in reference namelist : Pisces iron chemistry 384 ! 385 IF(lwp) THEN 386 WRITE(numout,*) 387 WRITE(numout,*) 'p4z_rem_init : Initialization of iron chemistry parameters' 388 WRITE(numout,*) '~~~~~~~~~~~~' 389 ENDIF 390 ! 391 REWIND( numnatp_ref ) ! Namelist nampisfer in reference namelist : Pisces iron chemistry 388 392 READ ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901) 389 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp ) 390 391 REWIND( numnatp_cfg ) ! Namelist nampisfer in configuration namelist : Pisces iron chemistry 393 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp ) 394 REWIND( numnatp_cfg ) ! Namelist nampisfer in configuration namelist : Pisces iron chemistry 392 395 READ ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 ) 393 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp ) 394 IF(lwm) WRITE ( numonp, nampisfer ) 395 396 IF(lwp) THEN ! control print 397 WRITE(numout,*) ' ' 398 WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer' 399 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 400 WRITE(numout,*) ' enable complex iron chemistry scheme ln_fechem =', ln_fechem 401 WRITE(numout,*) ' variable concentration of ligand ln_ligvar =', ln_ligvar 402 WRITE(numout,*) ' Variable colloidal fraction of Fe3+ ln_fecolloid =', ln_fecolloid 403 WRITE(numout,*) ' scavenging rate of Iron xlam1 =', xlam1 404 WRITE(numout,*) ' scavenging rate of Iron by dust xlamdust =', xlamdust 405 WRITE(numout,*) ' ligand concentration in the ocean ligand =', ligand 406 WRITE(numout,*) ' rate constant for nanoparticle formation kfep =', kfep 407 ENDIF 408 ! 409 IF( ln_fechem ) THEN 410 ! initialization of some constants used by the complexe chemistry scheme 411 ! ---------------------------------------------------------------------- 396 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp ) 397 IF(lwm) WRITE( numonp, nampisfer ) 398 399 IF(lwp) THEN ! control print 400 WRITE(numout,*) ' Namelist : nampisfer' 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 408 ENDIF 409 ! 410 IF( ln_fechem ) THEN ! set some constants used by the complexe chemistry scheme 411 ! 412 412 spd = 3600. * 24. 413 413 con = 1.E9 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r9125 r9169 4 4 !! TOP : PISCES CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 9 !! 10 !! 11 !! 6 !! History : - ! 1988-07 (E. MAIER-REIMER) Original code 7 !! - ! 1998 (O. Aumont) additions 8 !! - ! 1999 (C. Le Quere) modifications 9 !! 1.0 ! 2004 (O. Aumont) modifications 10 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 11 !! ! 2011-02 (J. Simeon, J. Orr) Include total atm P correction 12 12 !!---------------------------------------------------------------------- 13 13 !! p4z_flx : CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE … … 15 15 !! p4z_patm : Read sfc atm pressure [atm] for each grid cell 16 16 !!---------------------------------------------------------------------- 17 USE oce_trc 18 USE trc 19 USE sms_pisces 20 USE p4zche 21 USE prtctl_trc 22 USE iom 23 USE fldread 17 USE oce_trc ! shared variables between ocean and passive tracers 18 USE trc ! passive tracers common variables 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zche ! Chemical model 21 USE prtctl_trc ! print control for debugging 22 USE iom ! I/O manager 23 USE fldread ! read input fields 24 24 25 25 IMPLICIT NONE … … 30 30 PUBLIC p4z_flx_alloc 31 31 32 ! !!** Namelist nampisext **33 REAL(wp) :: atcco2!: pre-industrial atmospheric [co2] (ppm)34 LOGICAL :: ln_co2int!: flag to read in a file and interpolate atmospheric pco2 or not35 CHARACTER(len=34) :: clname!: filename of pco2 values36 INTEGER :: nn_offset!: Offset model-data start year (default = 0)32 ! !!** Namelist nampisext ** 33 REAL(wp) :: atcco2 !: pre-industrial atmospheric [co2] (ppm) 34 LOGICAL :: ln_co2int !: flag to read in a file and interpolate atmospheric pco2 or not 35 CHARACTER(len=34) :: clname !: filename of pco2 values 36 INTEGER :: nn_offset !: Offset model-data start year (default = 0) 37 37 38 38 !! Variables related to reading atmospheric CO2 time history 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years40 INTEGER :: nmaxrec, numco241 42 ! !!* nampisatm namelist (Atmospheric PRessure) *39 INTEGER :: nmaxrec, numco2 ! 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years ! 41 42 ! !!* nampisatm namelist (Atmospheric PRessure) * 43 43 LOGICAL, PUBLIC :: ln_presatm !: ref. pressure: global mean Patm (F) or a constant (F) 44 44 LOGICAL, PUBLIC :: ln_presatmco2 !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 45 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 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2 !: atmospheric pco251 52 REAL(wp) :: xconv = 0.01_wp / 3600._wp!: coefficients for conversion46 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 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2 !: atmospheric pco2 51 52 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 53 53 54 54 !!---------------------------------------------------------------------- … … 70 70 !! - Add option for time-interpolation of atcco2.txt 71 71 !!--------------------------------------------------------------------- 72 !73 72 INTEGER, INTENT(in) :: kt, knt ! 74 73 ! … … 79 78 REAL(wp) :: zph, zdic, zsch_o2, zsch_co2 80 79 REAL(wp) :: zyr_dec, zdco2dt 81 CHARACTER (len=25) :: charout82 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx, zpco2atm83 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d80 CHARACTER (len=25) :: charout 81 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx, zpco2atm 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d 84 83 !!--------------------------------------------------------------------- 85 84 ! 86 85 IF( ln_timing ) CALL timing_start('p4z_flx') 87 86 ! 88 89 87 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 90 88 ! SURFACE LAYER); THE RESULT OF THIS CALCULATION 91 89 ! IS USED TO COMPUTE AIR-SEA FLUX OF CO2 92 90 93 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 calcs91 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 94 92 95 93 IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN … … 226 224 !! ** Method : Read the nampisext namelist and check the parameters 227 225 !! called at the first timestep (nittrc000) 226 !! 228 227 !! ** input : Namelist nampisext 229 228 !!---------------------------------------------------------------------- 230 INTEGER :: jm 231 INTEGER :: ios ! Local integer 232 ! 229 INTEGER :: jm, ios ! Local integer 230 !! 233 231 NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 234 232 !!---------------------------------------------------------------------- 235 ! 236 233 IF(lwp) THEN 234 WRITE(numout,*) 235 WRITE(numout,*) ' p4z_flx_init : atmospheric conditions for air-sea flux calculation' 236 WRITE(numout,*) ' ~~~~~~~~~~~~' 237 ENDIF 238 ! 237 239 REWIND( numnatp_ref ) ! Namelist nampisext in reference namelist : Pisces atm. conditions 238 240 READ ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901) 239 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp ) 240 241 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp ) 241 242 REWIND( numnatp_cfg ) ! Namelist nampisext in configuration namelist : Pisces atm. conditions 242 243 READ ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 ) 243 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp )244 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp ) 244 245 IF(lwm) WRITE ( numonp, nampisext ) 245 246 ! 246 247 IF(lwp) THEN ! control print 247 WRITE(numout,*) ' ' 248 WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 249 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 250 WRITE(numout,*) ' Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 251 WRITE(numout,*) ' ' 252 ENDIF 248 WRITE(numout,*) ' Namelist : nampisext --- parameters for air-sea exchange' 249 WRITE(numout,*) ' reading in the atm pCO2 file or constant value ln_co2int =', ln_co2int 250 ENDIF 251 252 !!gm BUG !!! ===>>> ln_presatm and ln_presatmco2 are used below, but read in namelist 253 !!gm at the end of the routine via a CALL to CALL p4z_patm( nit000 ) 254 253 255 IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 254 256 IF(lwp) THEN ! control print 255 WRITE(numout,*) ' Constant Atmospheric pCO2 value atcco2 =', atcco2 256 WRITE(numout,*) ' ' 257 WRITE(numout,*) ' Constant Atmospheric pCO2 value atcco2 =', atcco2 257 258 ENDIF 258 259 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 259 260 ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 260 261 IF(lwp) THEN 261 WRITE(numout,*) ' Atmospheric pCO2 value from file clname =', TRIM( clname )262 WRITE(numout,*) ' Offset model-data start year nn_offset =', nn_offset263 WRITE(numout,*) ' '262 WRITE(numout,*) ' Constant Atmospheric pCO2 value atcco2 =', atcco2 263 WRITE(numout,*) ' Atmospheric pCO2 value from file clname =', TRIM( clname ) 264 WRITE(numout,*) ' Offset model-data start year nn_offset =', nn_offset 264 265 ENDIF 265 266 CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) … … 270 271 END DO 271 272 100 nmaxrec = jm - 1 272 ALLOCATE( years (nmaxrec) ) ;years (:) = 0._wp273 ALLOCATE( atcco2h(nmaxrec) ) ;atcco2h(:) = 0._wp274 273 ALLOCATE( years (nmaxrec) ) ; years (:) = 0._wp 274 ALLOCATE( atcco2h(nmaxrec) ) ; atcco2h(:) = 0._wp 275 ! 275 276 REWIND(numco2) 276 277 DO jm = 1, nmaxrec ! get xCO2 data … … 282 283 IF(lwp) THEN 283 284 WRITE(numout,*) ' Spatialized Atmospheric pCO2 from an external file' 284 WRITE(numout,*) ' '285 285 ENDIF 286 286 ELSE 287 287 IF(lwp) THEN 288 288 WRITE(numout,*) ' Spatialized Atmospheric pCO2 from an external file' 289 WRITE(numout,*) ' '290 289 ENDIF 291 290 ENDIF … … 304 303 !! *** ROUTINE p4z_atm *** 305 304 !! 306 !! ** Purpose : Read and interpolate the external atmospheric sea-lev l pressure305 !! ** Purpose : Read and interpolate the external atmospheric sea-level pressure 307 306 !! ** Method : Read the files and interpolate the appropriate variables 308 307 !! 309 308 !!---------------------------------------------------------------------- 310 INTEGER, INTENT( in ) :: kt ! ocean time step 311 ! 312 INTEGER :: ierr 313 INTEGER :: ios ! Local integer output status for namelist read 314 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 315 TYPE(FLD_N) :: sn_patm ! informations about the fields to be read 316 TYPE(FLD_N) :: sn_atmco2 ! informations about the fields to be read 309 INTEGER, INTENT(in) :: kt ! ocean time step 310 ! 311 INTEGER :: ierr, ios ! Local integer 312 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 313 TYPE(FLD_N) :: sn_patm ! informations about the fields to be read 314 TYPE(FLD_N) :: sn_atmco2 ! informations about the fields to be read 317 315 !! 318 316 NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 319 317 !!---------------------------------------------------------------------- 320 321 ! ! ----------------------- ! 322 IF( kt == nit000 ) THEN ! First call kt=nittrc000 ! 323 318 ! 319 IF( kt == nit000 ) THEN !== First call kt=nittrc000 ==! 320 ! 321 IF(lwp) THEN 322 WRITE(numout,*) 323 WRITE(numout,*) ' p4z_patm : sea-level atmospheric pressure' 324 WRITE(numout,*) ' ~~~~~~~~' 325 ENDIF 326 ! 324 327 REWIND( numnatp_ref ) ! Namelist nampisatm in reference namelist : Pisces atm. sea level pressure file 325 328 READ ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901) 326 329 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist', lwp ) 327 328 330 REWIND( numnatp_cfg ) ! Namelist nampisatm in configuration namelist : Pisces atm. sea level pressure file 329 331 READ ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 ) 330 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp )332 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp ) 331 333 IF(lwm) WRITE ( numonp, nampisatm ) 332 334 ! 333 335 ! 334 336 IF(lwp) THEN !* control print 335 WRITE(numout,*) 336 WRITE(numout,*) ' Namelist nampisatm : Atmospheric Pressure as external forcing' 337 WRITE(numout,*) ' constant atmopsheric pressure (F) or from a file (T) ln_presatm = ', ln_presatm 338 WRITE(numout,*) ' spatial atmopsheric CO2 for flux calcs ln_presatmco2 = ', ln_presatmco2 339 WRITE(numout,*) 337 WRITE(numout,*) ' Namelist : nampisatm --- Atmospheric Pressure as external forcing' 338 WRITE(numout,*) ' constant atmopsheric pressure (F) or from a file (T) ln_presatm = ', ln_presatm 339 WRITE(numout,*) ' spatial atmopsheric CO2 for flux calcs ln_presatmco2 = ', ln_presatmco2 340 340 ENDIF 341 341 ! … … 358 358 ENDIF 359 359 ! 360 IF( .NOT.ln_presatm ) patm(:,:) = 1. e0! Initialize patm if no reading from a file360 IF( .NOT.ln_presatm ) patm(:,:) = 1._wp ! Initialize patm if no reading from a file 361 361 ! 362 362 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90
r9124 r9169 6 6 !! History : 3.6 ! 2016-03 (O. Aumont, A. Tagliabue) Quota model and reorganization 7 7 !!---------------------------------------------------------------------- 8 !! p4z_ligand 9 !! p4z_ligand_init 8 !! p4z_ligand : Compute remineralization/dissolution of organic ligands 9 !! p4z_ligand_init: Initialisation of parameters for remineralisation 10 10 !!---------------------------------------------------------------------- 11 USE oce_trc ! 12 USE trc ! 13 USE sms_pisces ! 14 USE prtctl_trc ! 11 USE oce_trc ! shared variables between ocean and passive tracers 12 USE trc ! passive tracers common variables 13 USE sms_pisces ! PISCES Source Minus Sink variables 14 USE prtctl_trc ! print control for debugging 15 15 16 16 IMPLICIT NONE … … 20 20 PUBLIC p4z_ligand_init ! called in trcsms_pisces.F90 21 21 22 !! * Shared module variables23 22 REAL(wp), PUBLIC :: rlgw !: lifetime (years) of weak ligands 24 23 REAL(wp), PUBLIC :: rlgs !: lifetime (years) of strong ligands … … 39 38 !! 40 39 !! ** Purpose : Compute remineralization/scavenging of organic ligands 41 !!42 !! ** Method : - ???43 40 !!--------------------------------------------------------------------- 44 !45 41 INTEGER, INTENT(in) :: kt, knt ! ocean time step 46 42 ! 47 43 INTEGER :: ji, jj, jk 48 44 REAL(wp) :: zlgwp, zlgwpr, zlgwr, zlablgw, zrfepa, zfepr 49 CHARACTER (len=25) :: charout45 CHARACTER (len=25) :: charout 50 46 !!--------------------------------------------------------------------- 51 47 ! 52 48 IF( ln_timing ) CALL timing_start('p4z_ligand') 53 49 ! 54 ! ------------------------------------------------------------------55 ! Remineralization of iron ligands56 ! ------------------------------------------------------------------57 50 DO jk = 1, jpkm1 58 51 DO jj = 1, jpj 59 52 DO ji = 1, jpi 53 ! 54 ! ------------------------------------------------------------------ 55 ! Remineralization of iron ligands 56 ! ------------------------------------------------------------------ 60 57 ! production from remineralisation of organic matter 61 58 zlgwp = orem(ji,jj,jk) * rlig … … 68 65 zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 69 66 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 70 END DO 71 END DO 72 END DO 73 74 ! ---------------------------------------------------------- 75 ! Dissolution of nanoparticle Fe 76 ! ---------------------------------------------------------- 77 DO jk = 1, jpkm1 78 DO jj = 1, jpj 79 DO ji = 1, jpi 67 ! 68 ! ---------------------------------------------------------- 69 ! Dissolution of nanoparticle Fe 70 ! ---------------------------------------------------------- 80 71 ! dissolution rate is maximal in the presence of light and 81 72 ! lower in the aphotici zone … … 86 77 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) - zfepr 87 78 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zfepr 79 ! 88 80 END DO 89 81 END DO 90 82 END DO 91 83 ! 92 84 IF(ln_ctl) THEN ! print mean trends (used for debugging) 93 85 WRITE(charout, FMT="('ligand1')") 94 86 CALL prt_ctl_trc_info(charout) 95 87 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 96 88 ENDIF 97 89 ! 98 90 IF( ln_timing ) CALL timing_stop('p4z_ligand') … … 108 100 !! 109 101 !! ** Method : Read the nampislig namelist and check the parameters 110 !! called at the first timestep111 102 !! 112 103 !! ** input : Namelist nampislig 113 !!114 104 !!---------------------------------------------------------------------- 115 105 INTEGER :: ios ! Local integer … … 117 107 NAMELIST/nampislig/ rlgw, prlgw, rlgs, rfep, rlig 118 108 !!---------------------------------------------------------------------- 119 109 ! 110 IF(lwp) THEN 111 WRITE(numout,*) 112 WRITE(numout,*) 'p4z_ligand_init : remineralization/scavenging of organic ligands' 113 WRITE(numout,*) '~~~~~~~~~~~~~~~' 114 ENDIF 120 115 REWIND( numnatp_ref ) ! Namelist nampislig in reference namelist : Pisces remineralization 121 116 READ ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901) 122 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp ) 123 117 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp ) 124 118 REWIND( numnatp_cfg ) ! Namelist nampislig in configuration namelist : Pisces remineralization 125 119 READ ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 ) 126 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp )120 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp ) 127 121 IF(lwm) WRITE ( numonp, nampislig ) 128 122 ! 129 123 IF(lwp) THEN ! control print 130 WRITE(numout,*) ' ' 131 WRITE(numout,*) ' Namelist parameters for ligands, nampislig' 132 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 133 WRITE(numout,*) ' Dissolution rate of FeP rfep =', rfep 134 WRITE(numout,*) ' Lifetime (years) of weak ligands rlgw =', rlgw 135 WRITE(numout,*) ' Remin ligand production per unit C rlig =', rlig 136 WRITE(numout,*) ' Photolysis of weak ligand prlgw =', prlgw 137 WRITE(numout,*) ' Lifetime (years) of strong ligands rlgs =', rlgs 124 WRITE(numout,*) ' Namelist : nampislig' 125 WRITE(numout,*) ' Dissolution rate of FeP rfep =', rfep 126 WRITE(numout,*) ' Lifetime (years) of weak ligands rlgw =', rlgw 127 WRITE(numout,*) ' Remin ligand production per unit C rlig =', rlig 128 WRITE(numout,*) ' Photolysis of weak ligand prlgw =', prlgw 129 WRITE(numout,*) ' Lifetime (years) of strong ligands rlgs =', rlgs 138 130 ENDIF 139 131 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r9124 r9169 215 215 ! 216 216 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics 217 IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht218 IF( iom_use( "LNnut" ) ) CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term219 IF( iom_use( "LDnut" ) ) CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term220 IF( iom_use( "LNFe" ) ) CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term221 IF( iom_use( "LDFe" ) ) CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term217 IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht 218 IF( iom_use( "LNnut" ) ) CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 219 IF( iom_use( "LDnut" ) ) CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 220 IF( iom_use( "LNFe" ) ) CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 221 IF( iom_use( "LDFe" ) ) CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 222 222 ENDIF 223 223 ! … … 246 246 !!---------------------------------------------------------------------- 247 247 ! 248 IF(lwp) THEN 249 WRITE(numout,*) 250 WRITE(numout,*) 'p4z_lim_init : initialization of nutrient limitations' 251 WRITE(numout,*) '~~~~~~~~~~~~' 252 ENDIF 253 ! 248 254 REWIND( numnatp_ref ) ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 249 255 READ ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 250 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 251 ! 256 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 252 257 REWIND( numnatp_cfg ) ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 253 258 READ ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 254 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp )255 IF(lwm) WRITE 259 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 260 IF(lwm) WRITE( numonp, namp4zlim ) 256 261 ! 257 262 IF(lwp) THEN ! control print 258 WRITE(numout,*) ' ' 259 WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim' 260 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 261 WRITE(numout,*) ' mean rainratio caco3r = ', caco3r 262 WRITE(numout,*) ' NO3 half saturation of nanophyto concnno3 = ', concnno3 263 WRITE(numout,*) ' NO3 half saturation of diatoms concdno3 = ', concdno3 264 WRITE(numout,*) ' NH4 half saturation for phyto concnnh4 = ', concnnh4 265 WRITE(numout,*) ' NH4 half saturation for diatoms concdnh4 = ', concdnh4 266 WRITE(numout,*) ' half saturation constant for Si uptake xksi1 = ', xksi1 267 WRITE(numout,*) ' half saturation constant for Si/C xksi2 = ', xksi2 268 WRITE(numout,*) ' half-sat. of DOC remineralization xkdoc = ', xkdoc 269 WRITE(numout,*) ' Iron half saturation for nanophyto concnfer = ', concnfer 270 WRITE(numout,*) ' Iron half saturation for diatoms concdfer = ', concdfer 271 WRITE(numout,*) ' size ratio for nanophytoplankton xsizern = ', xsizern 272 WRITE(numout,*) ' size ratio for diatoms xsizerd = ', xsizerd 273 WRITE(numout,*) ' NO3 half saturation of bacteria concbno3 = ', concbno3 274 WRITE(numout,*) ' NH4 half saturation for bacteria concbnh4 = ', concbnh4 275 WRITE(numout,*) ' Minimum size criteria for diatoms xsizedia = ', xsizedia 276 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy 277 WRITE(numout,*) ' Fe half saturation for bacteria concbfe = ', concbfe 278 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =' , oxymin 279 WRITE(numout,*) ' optimal Fe quota for nano. qnfelim = ', qnfelim 280 WRITE(numout,*) ' Optimal Fe quota for diatoms qdfelim = ', qdfelim 263 WRITE(numout,*) ' Namelist : namp4zlim' 264 WRITE(numout,*) ' mean rainratio caco3r = ', caco3r 265 WRITE(numout,*) ' NO3 half saturation of nanophyto concnno3 = ', concnno3 266 WRITE(numout,*) ' NO3 half saturation of diatoms concdno3 = ', concdno3 267 WRITE(numout,*) ' NH4 half saturation for phyto concnnh4 = ', concnnh4 268 WRITE(numout,*) ' NH4 half saturation for diatoms concdnh4 = ', concdnh4 269 WRITE(numout,*) ' half saturation constant for Si uptake xksi1 = ', xksi1 270 WRITE(numout,*) ' half saturation constant for Si/C xksi2 = ', xksi2 271 WRITE(numout,*) ' half-sat. of DOC remineralization xkdoc = ', xkdoc 272 WRITE(numout,*) ' Iron half saturation for nanophyto concnfer = ', concnfer 273 WRITE(numout,*) ' Iron half saturation for diatoms concdfer = ', concdfer 274 WRITE(numout,*) ' size ratio for nanophytoplankton xsizern = ', xsizern 275 WRITE(numout,*) ' size ratio for diatoms xsizerd = ', xsizerd 276 WRITE(numout,*) ' NO3 half saturation of bacteria concbno3 = ', concbno3 277 WRITE(numout,*) ' NH4 half saturation for bacteria concbnh4 = ', concbnh4 278 WRITE(numout,*) ' Minimum size criteria for diatoms xsizedia = ', xsizedia 279 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy 280 WRITE(numout,*) ' Fe half saturation for bacteria concbfe = ', concbfe 281 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =' , oxymin 282 WRITE(numout,*) ' optimal Fe quota for nano. qnfelim = ', qnfelim 283 WRITE(numout,*) ' Optimal Fe quota for diatoms qdfelim = ', qdfelim 281 284 ENDIF 282 285 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r9125 r9169 29 29 PUBLIC p4z_lys_init ! called in trcsms_pisces.F90 30 30 31 !! * Shared module variables 32 REAL(wp), PUBLIC :: kdca !: diss. rate constant calcite 33 REAL(wp), PUBLIC :: nca !: order of reaction for calcite dissolution 31 REAL(wp), PUBLIC :: kdca !: diss. rate constant calcite 32 REAL(wp), PUBLIC :: nca !: order of reaction for calcite dissolution 34 33 35 !! * Module variables36 REAL(wp) :: calcon = 1.03E-2 !:mean calcite concentration [Ca2+] in sea water [mole/kg solution]34 INTEGER :: rmtss ! number of seconds per month 35 REAL(wp) :: calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 37 36 38 INTEGER :: rmtss !: number of seconds per month39 40 37 !!---------------------------------------------------------------------- 41 38 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 56 53 !! ** Method : - ??? 57 54 !!--------------------------------------------------------------------- 55 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 58 56 ! 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step60 57 INTEGER :: ji, jj, jk, jn 61 58 REAL(wp) :: zdispot, zfact, zcalcon 62 59 REAL(wp) :: zomegaca, zexcess, zexcess0 63 CHARACTER (len=25) :: charout64 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat60 CHARACTER (len=25) :: charout 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat 65 62 !!--------------------------------------------------------------------- 66 63 ! … … 69 66 zco3 (:,:,:) = 0. 70 67 zcaldiss(:,:,:) = 0. 71 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 68 zhinit (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 69 ! 72 70 ! ------------------------------------------- 73 71 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS 74 72 ! ------------------------------------------- 75 73 76 CALL solve_at_general( zhinit, zhi)74 CALL solve_at_general( zhinit, zhi ) 77 75 78 76 DO jk = 1, jpkm1 … … 80 78 DO ji = 1, jpi 81 79 zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 82 &+ ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )83 hi (ji,jj,jk)= zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.80 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 81 hi (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 84 82 END DO 85 83 END DO … … 158 156 NAMELIST/nampiscal/ kdca, nca 159 157 !!---------------------------------------------------------------------- 158 IF(lwp) THEN 159 WRITE(numout,*) 160 WRITE(numout,*) 'p4z_lys_init : initialization of CaCO3 dissolution' 161 WRITE(numout,*) '~~~~~~~~~~~~' 162 ENDIF 160 163 ! 161 164 REWIND( numnatp_ref ) ! Namelist nampiscal in reference namelist : Pisces CaCO3 dissolution 162 165 READ ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901) 163 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp ) 164 ! 166 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp ) 165 167 REWIND( numnatp_cfg ) ! Namelist nampiscal in configuration namelist : Pisces CaCO3 dissolution 166 168 READ ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 ) 167 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp )168 IF(lwm) WRITE 169 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp ) 170 IF(lwm) WRITE( numonp, nampiscal ) 169 171 ! 170 172 IF(lwp) THEN ! control print 171 WRITE(numout,*) ' ' 172 WRITE(numout,*) ' Namelist parameters for CaCO3 dissolution, nampiscal' 173 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 174 WRITE(numout,*) ' diss. rate constant calcite (per month) kdca =', kdca 175 WRITE(numout,*) ' order of reaction for calcite dissolution nca =', nca 173 WRITE(numout,*) ' Namelist : nampiscal' 174 WRITE(numout,*) ' diss. rate constant calcite (per month) kdca =', kdca 175 WRITE(numout,*) ' order of reaction for calcite dissolution nca =', nca 176 176 ENDIF 177 177 ! … … 180 180 ! 181 181 END SUBROUTINE p4z_lys_init 182 182 183 !!====================================================================== 183 184 END MODULE p4zlys -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r9125 r9169 8 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 !! p4z_meso : 11 !! p4z_meso_init : 12 !!---------------------------------------------------------------------- 13 USE oce_trc ! 14 USE trc ! 15 USE sms_pisces ! 16 USE p4zprod ! 17 USE prtctl_trc ! 18 USE iom ! 10 !! p4z_meso : Compute the sources/sinks for mesozooplankton 11 !! p4z_meso_init : Initialization of the parameters for mesozooplankton 12 !!---------------------------------------------------------------------- 13 USE oce_trc ! shared variables between ocean and passive tracers 14 USE trc ! passive tracers common variables 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p4zprod ! production 17 USE prtctl_trc ! print control for debugging 18 USE iom ! I/O manager 19 19 20 20 IMPLICIT NONE … … 24 24 PUBLIC p4z_meso_init ! called in trcsms_pisces.F90 25 25 26 !! * Shared module variables27 26 REAL(wp), PUBLIC :: part2 !: part of calcite not dissolved in mesozoo guts 28 27 REAL(wp), PUBLIC :: xprefc !: mesozoo preference for POC … … 49 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 49 !!---------------------------------------------------------------------- 51 52 50 CONTAINS 53 51 … … 60 58 !! ** Method : - ??? 61 59 !!--------------------------------------------------------------------- 62 INTEGER, INTENT(in) :: kt, knt ! ocean time step 60 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 61 ! 63 62 INTEGER :: ji, jj, jk 64 63 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam … … 73 72 CHARACTER (len=25) :: charout 74 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 76 74 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 77 75 !!--------------------------------------------------------------------- 78 76 ! … … 122 120 123 121 ! Mesozooplankton flux feeding on GOC 124 ! ----------------------------------125 122 ! ---------------------------------- 126 123 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & … … 253 250 !! 254 251 !! ** input : Namelist nampismes 255 !!256 252 !!---------------------------------------------------------------------- 257 253 INTEGER :: ios ! Local integer … … 262 258 !!---------------------------------------------------------------------- 263 259 ! 260 IF(lwp) THEN 261 WRITE(numout,*) 262 WRITE(numout,*) 'p4z_meso_init : Initialization of mesozooplankton parameters' 263 WRITE(numout,*) '~~~~~~~~~~~~~' 264 ENDIF 265 ! 264 266 REWIND( numnatp_ref ) ! Namelist nampismes in reference namelist : Pisces mesozooplankton 265 267 READ ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 266 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 267 ! 268 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 268 269 REWIND( numnatp_cfg ) ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 269 270 READ ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 270 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp )271 IF(lwm) WRITE 271 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 272 IF(lwm) WRITE( numonp, namp4zmes ) 272 273 ! 273 274 IF(lwp) THEN ! control print 274 WRITE(numout,*) ' ' 275 WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes' 276 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 277 WRITE(numout,*) ' part of calcite not dissolved in mesozoo guts part2 =', part2 278 WRITE(numout,*) ' mesozoo preference for phyto xprefc =', xprefc 279 WRITE(numout,*) ' mesozoo preference for POC xprefp =', xprefp 280 WRITE(numout,*) ' mesozoo preference for zoo xprefz =', xprefz 281 WRITE(numout,*) ' mesozoo preference for poc xprefpoc =', xprefpoc 282 WRITE(numout,*) ' microzoo feeding threshold for mesozoo xthresh2zoo =', xthresh2zoo 283 WRITE(numout,*) ' diatoms feeding threshold for mesozoo xthresh2dia =', xthresh2dia 284 WRITE(numout,*) ' nanophyto feeding threshold for mesozoo xthresh2phy =', xthresh2phy 285 WRITE(numout,*) ' poc feeding threshold for mesozoo xthresh2poc =', xthresh2poc 286 WRITE(numout,*) ' feeding threshold for mesozooplankton xthresh2 =', xthresh2 287 WRITE(numout,*) ' exsudation rate of mesozooplankton resrat2 =', resrat2 288 WRITE(numout,*) ' mesozooplankton mortality rate mzrat2 =', mzrat2 289 WRITE(numout,*) ' maximal mesozoo grazing rate grazrat2 =', grazrat2 290 WRITE(numout,*) ' mesozoo flux feeding rate grazflux =', grazflux 291 WRITE(numout,*) ' non assimilated fraction of P by mesozoo unass2 =', unass2 292 WRITE(numout,*) ' Efficicency of Mesozoo growth epsher2 =', epsher2 293 WRITE(numout,*) ' Fraction of mesozoo excretion as DOM sigma2 =', sigma2 294 WRITE(numout,*) ' half sturation constant for grazing 2 xkgraz2 =', xkgraz2 275 WRITE(numout,*) ' Namelist : namp4zmes' 276 WRITE(numout,*) ' part of calcite not dissolved in mesozoo guts part2 =', part2 277 WRITE(numout,*) ' mesozoo preference for phyto xprefc =', xprefc 278 WRITE(numout,*) ' mesozoo preference for POC xprefp =', xprefp 279 WRITE(numout,*) ' mesozoo preference for zoo xprefz =', xprefz 280 WRITE(numout,*) ' mesozoo preference for poc xprefpoc =', xprefpoc 281 WRITE(numout,*) ' microzoo feeding threshold for mesozoo xthresh2zoo =', xthresh2zoo 282 WRITE(numout,*) ' diatoms feeding threshold for mesozoo xthresh2dia =', xthresh2dia 283 WRITE(numout,*) ' nanophyto feeding threshold for mesozoo xthresh2phy =', xthresh2phy 284 WRITE(numout,*) ' poc feeding threshold for mesozoo xthresh2poc =', xthresh2poc 285 WRITE(numout,*) ' feeding threshold for mesozooplankton xthresh2 =', xthresh2 286 WRITE(numout,*) ' exsudation rate of mesozooplankton resrat2 =', resrat2 287 WRITE(numout,*) ' mesozooplankton mortality rate mzrat2 =', mzrat2 288 WRITE(numout,*) ' maximal mesozoo grazing rate grazrat2 =', grazrat2 289 WRITE(numout,*) ' mesozoo flux feeding rate grazflux =', grazflux 290 WRITE(numout,*) ' non assimilated fraction of P by mesozoo unass2 =', unass2 291 WRITE(numout,*) ' Efficicency of Mesozoo growth epsher2 =', epsher2 292 WRITE(numout,*) ' Fraction of mesozoo excretion as DOM sigma2 =', sigma2 293 WRITE(numout,*) ' half sturation constant for grazing 2 xkgraz2 =', xkgraz2 295 294 ENDIF 296 295 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r9125 r9169 8 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 9 9 !!---------------------------------------------------------------------- 10 !! p4z_micro :Compute the sources/sinks for microzooplankton11 !! p4z_micro_init :Initialize and read the appropriate namelist12 !!---------------------------------------------------------------------- 13 USE oce_trc ! 14 USE trc ! 15 USE sms_pisces ! 16 USE p4zlim ! 17 USE p4zprod ! 18 USE iom ! 19 USE prtctl_trc ! 10 !! p4z_micro : Compute the sources/sinks for microzooplankton 11 !! p4z_micro_init : Initialize and read the appropriate namelist 12 !!---------------------------------------------------------------------- 13 USE oce_trc ! shared variables between ocean and passive tracers 14 USE trc ! passive tracers common variables 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 USE p4zlim ! Co-limitations 17 USE p4zprod ! production 18 USE iom ! I/O manager 19 USE prtctl_trc ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 25 25 PUBLIC p4z_micro_init ! called in trcsms_pisces.F90 26 26 27 !! * Shared module variables 28 REAL(wp), PUBLIC :: part !: part of calcite not dissolved in microzoo guts 29 REAL(wp), PUBLIC :: xpref2c !: microzoo preference for POC 30 REAL(wp), PUBLIC :: xpref2p !: microzoo preference for nanophyto 31 REAL(wp), PUBLIC :: xpref2d !: microzoo preference for diatoms 32 REAL(wp), PUBLIC :: xthreshdia !: diatoms feeding threshold for microzooplankton 33 REAL(wp), PUBLIC :: xthreshphy !: nanophyto threshold for microzooplankton 34 REAL(wp), PUBLIC :: xthreshpoc !: poc threshold for microzooplankton 35 REAL(wp), PUBLIC :: xthresh !: feeding threshold for microzooplankton 36 REAL(wp), PUBLIC :: resrat !: exsudation rate of microzooplankton 37 REAL(wp), PUBLIC :: mzrat !: microzooplankton mortality rate 38 REAL(wp), PUBLIC :: grazrat !: maximal microzoo grazing rate 39 REAL(wp), PUBLIC :: xkgraz !: non assimilated fraction of P by microzoo 40 REAL(wp), PUBLIC :: unass !: Efficicency of microzoo growth 41 REAL(wp), PUBLIC :: sigma1 !: Fraction of microzoo excretion as DOM 42 REAL(wp), PUBLIC :: epsher !: half sturation constant for grazing 1 27 REAL(wp), PUBLIC :: part !: part of calcite not dissolved in microzoo guts 28 REAL(wp), PUBLIC :: xpref2c !: microzoo preference for POC 29 REAL(wp), PUBLIC :: xpref2p !: microzoo preference for nanophyto 30 REAL(wp), PUBLIC :: xpref2d !: microzoo preference for diatoms 31 REAL(wp), PUBLIC :: xthreshdia !: diatoms feeding threshold for microzooplankton 32 REAL(wp), PUBLIC :: xthreshphy !: nanophyto threshold for microzooplankton 33 REAL(wp), PUBLIC :: xthreshpoc !: poc threshold for microzooplankton 34 REAL(wp), PUBLIC :: xthresh !: feeding threshold for microzooplankton 35 REAL(wp), PUBLIC :: resrat !: exsudation rate of microzooplankton 36 REAL(wp), PUBLIC :: mzrat !: microzooplankton mortality rate 37 REAL(wp), PUBLIC :: grazrat !: maximal microzoo grazing rate 38 REAL(wp), PUBLIC :: xkgraz !: non assimilated fraction of P by microzoo 39 REAL(wp), PUBLIC :: unass !: Efficicency of microzoo growth 40 REAL(wp), PUBLIC :: sigma1 !: Fraction of microzoo excretion as DOM 41 REAL(wp), PUBLIC :: epsher !: half sturation constant for grazing 1 43 42 44 43 !!---------------------------------------------------------------------- … … 57 56 !! ** Method : - ??? 58 57 !!--------------------------------------------------------------------- 59 INTEGER, INTENT(in) :: kt! ocean time step60 INTEGER, INTENT(in) :: knt58 INTEGER, INTENT(in) :: kt ! ocean time step 59 INTEGER, INTENT(in) :: knt ! ??? 61 60 ! 62 61 INTEGER :: ji, jj, jk … … 185 184 ENDIF 186 185 ! 187 IF(ln_ctl) THEN! print mean trends (used for debugging)186 IF(ln_ctl) THEN ! print mean trends (used for debugging) 188 187 WRITE(charout, FMT="('micro')") 189 188 CALL prt_ctl_trc_info(charout) … … 215 214 !!---------------------------------------------------------------------- 216 215 ! 216 IF(lwp) THEN 217 WRITE(numout,*) 218 WRITE(numout,*) 'p4z_micro_init : Initialization of microzooplankton parameters' 219 WRITE(numout,*) '~~~~~~~~~~~~~~' 220 ENDIF 221 ! 217 222 REWIND( numnatp_ref ) ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 218 223 READ ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 219 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 220 ! 224 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 221 225 REWIND( numnatp_cfg ) ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 222 226 READ ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 223 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp )224 IF(lwm) WRITE 227 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 228 IF(lwm) WRITE( numonp, namp4zzoo ) 225 229 ! 226 230 IF(lwp) THEN ! control print 227 WRITE(numout,*) ' ' 228 WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo' 229 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 230 WRITE(numout,*) ' part of calcite not dissolved in microzoo guts part =', part 231 WRITE(numout,*) ' microzoo preference for POC xpref2c =', xpref2c 232 WRITE(numout,*) ' microzoo preference for nano xpref2p =', xpref2p 233 WRITE(numout,*) ' microzoo preference for diatoms xpref2d =', xpref2d 234 WRITE(numout,*) ' diatoms feeding threshold for microzoo xthreshdia =', xthreshdia 235 WRITE(numout,*) ' nanophyto feeding threshold for microzoo xthreshphy =', xthreshphy 236 WRITE(numout,*) ' poc feeding threshold for microzoo xthreshpoc =', xthreshpoc 237 WRITE(numout,*) ' feeding threshold for microzooplankton xthresh =', xthresh 238 WRITE(numout,*) ' exsudation rate of microzooplankton resrat =', resrat 239 WRITE(numout,*) ' microzooplankton mortality rate mzrat =', mzrat 240 WRITE(numout,*) ' maximal microzoo grazing rate grazrat =', grazrat 241 WRITE(numout,*) ' non assimilated fraction of P by microzoo unass =', unass 242 WRITE(numout,*) ' Efficicency of microzoo growth epsher =', epsher 243 WRITE(numout,*) ' Fraction of microzoo excretion as DOM sigma1 =', sigma1 244 WRITE(numout,*) ' half sturation constant for grazing 1 xkgraz =', xkgraz 231 WRITE(numout,*) ' Namelist : namp4zzoo' 232 WRITE(numout,*) ' part of calcite not dissolved in microzoo guts part =', part 233 WRITE(numout,*) ' microzoo preference for POC xpref2c =', xpref2c 234 WRITE(numout,*) ' microzoo preference for nano xpref2p =', xpref2p 235 WRITE(numout,*) ' microzoo preference for diatoms xpref2d =', xpref2d 236 WRITE(numout,*) ' diatoms feeding threshold for microzoo xthreshdia =', xthreshdia 237 WRITE(numout,*) ' nanophyto feeding threshold for microzoo xthreshphy =', xthreshphy 238 WRITE(numout,*) ' poc feeding threshold for microzoo xthreshpoc =', xthreshpoc 239 WRITE(numout,*) ' feeding threshold for microzooplankton xthresh =', xthresh 240 WRITE(numout,*) ' exsudation rate of microzooplankton resrat =', resrat 241 WRITE(numout,*) ' microzooplankton mortality rate mzrat =', mzrat 242 WRITE(numout,*) ' maximal microzoo grazing rate grazrat =', grazrat 243 WRITE(numout,*) ' non assimilated fraction of P by microzoo unass =', unass 244 WRITE(numout,*) ' Efficicency of microzoo growth epsher =', epsher 245 WRITE(numout,*) ' Fraction of microzoo excretion as DOM sigma1 =', sigma1 246 WRITE(numout,*) ' half sturation constant for grazing 1 xkgraz =', xkgraz 245 247 ENDIF 246 248 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r9124 r9169 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 !! p4z_mort : 10 !! p4z_mort_init : 11 !!---------------------------------------------------------------------- 12 USE oce_trc ! 13 USE trc ! 14 USE sms_pisces ! 15 USE p4zprod ! 16 USE p4zlim ! 17 USE prtctl_trc ! 9 !! p4z_mort : Compute the mortality terms for phytoplankton 10 !! p4z_mort_init : Initialize the mortality params for phytoplankton 11 !!---------------------------------------------------------------------- 12 USE oce_trc ! shared variables between ocean and passive tracers 13 USE trc ! passive tracers common variables 14 USE sms_pisces ! PISCES Source Minus Sink variables 15 USE p4zprod ! Primary productivity 16 USE p4zlim ! Phytoplankton limitation terms 17 USE prtctl_trc ! print control for debugging 18 18 19 19 IMPLICIT NONE … … 23 23 PUBLIC p4z_mort_init 24 24 25 !! * Shared module variables 26 REAL(wp), PUBLIC :: wchl !: 27 REAL(wp), PUBLIC :: wchld !: 28 REAL(wp), PUBLIC :: wchldm !: 29 REAL(wp), PUBLIC :: mprat !: 30 REAL(wp), PUBLIC :: mprat2 !: 25 REAL(wp), PUBLIC :: wchl !: 26 REAL(wp), PUBLIC :: wchld !: 27 REAL(wp), PUBLIC :: wchldm !: 28 REAL(wp), PUBLIC :: mprat !: 29 REAL(wp), PUBLIC :: mprat2 !: 31 30 32 31 !!---------------------------------------------------------------------- … … 35 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 35 !!---------------------------------------------------------------------- 37 38 36 CONTAINS 39 37 … … 49 47 INTEGER, INTENT(in) :: kt ! ocean time step 50 48 !!--------------------------------------------------------------------- 51 49 ! 52 50 CALL p4z_nano ! nanophytoplankton 53 51 ! 54 52 CALL p4z_diat ! diatoms 55 53 ! 56 54 END SUBROUTINE p4z_mort 57 55 … … 65 63 !! ** Method : - ??? 66 64 !!--------------------------------------------------------------------- 67 INTEGER :: ji, jj, jk68 REAL(wp) :: zsizerat, zcompaph69 REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal70 REAL(wp) :: ztortp , zrespp , zmortp71 CHARACTER (len=25) :: charout65 INTEGER :: ji, jj, jk 66 REAL(wp) :: zsizerat, zcompaph 67 REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 68 REAL(wp) :: ztortp , zrespp , zmortp 69 CHARACTER (len=25) :: charout 72 70 !!--------------------------------------------------------------------- 73 71 ! 74 72 IF( ln_timing ) CALL timing_start('p4z_nano') 75 73 ! 76 prodcal(:,:,:) = 0. !:calcite production variable set to zero74 prodcal(:,:,:) = 0._wp ! calcite production variable set to zero 77 75 DO jk = 1, jpkm1 78 76 DO jj = 1, jpj … … 139 137 !! ** Method : - ??? 140 138 !!--------------------------------------------------------------------- 141 INTEGER :: ji, jj, jk142 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi143 REAL(wp) :: zrespp2, ztortp2, zmortp2144 REAL(wp) :: zlim2, zlim1145 CHARACTER (len=25) :: charout139 INTEGER :: ji, jj, jk 140 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi 141 REAL(wp) :: zrespp2, ztortp2, zmortp2 142 REAL(wp) :: zlim2, zlim1 143 CHARACTER (len=25) :: charout 146 144 !!--------------------------------------------------------------------- 147 145 ! 148 146 IF( ln_timing ) CALL timing_start('p4z_diat') 149 147 ! 150 151 148 ! Aggregation term for diatoms is increased in case of nutrient 152 149 ! stress as observed in reality. The stressed cells become more … … 196 193 END DO 197 194 ! 198 IF(ln_ctl) THEN! print mean trends (used for debugging)195 IF(ln_ctl) THEN ! print mean trends (used for debugging) 199 196 WRITE(charout, FMT="('diat')") 200 197 CALL prt_ctl_trc_info(charout) … … 214 211 !! 215 212 !! ** Method : Read the nampismort namelist and check the parameters 216 !! called at the first timestep213 !! called at the first timestep 217 214 !! 218 215 !! ** input : Namelist nampismort … … 224 221 !!---------------------------------------------------------------------- 225 222 ! 223 IF(lwp) THEN 224 WRITE(numout,*) 225 WRITE(numout,*) 'p4z_mort_init : Initialization of phytoplankton mortality parameters' 226 WRITE(numout,*) '~~~~~~~~~~~~~' 227 ENDIF 228 ! 226 229 REWIND( numnatp_ref ) ! Namelist nampismort in reference namelist : Pisces phytoplankton 227 230 READ ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 228 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 229 ! 231 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 230 232 REWIND( numnatp_cfg ) ! Namelist nampismort in configuration namelist : Pisces phytoplankton 231 233 READ ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 232 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp )233 IF(lwm) WRITE 234 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 235 IF(lwm) WRITE( numonp, namp4zmort ) 234 236 ! 235 237 IF(lwp) THEN ! control print 236 WRITE(numout,*) ' ' 237 WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort' 238 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 239 WRITE(numout,*) ' quadratic mortality of phytoplankton wchl =', wchl 240 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchld =', wchld 241 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchldm =', wchldm 242 WRITE(numout,*) ' phytoplankton mortality rate mprat =', mprat 243 WRITE(numout,*) ' Diatoms mortality rate mprat2 =', mprat2 238 WRITE(numout,*) ' Namelist : namp4zmort' 239 WRITE(numout,*) ' quadratic mortality of phytoplankton wchl =', wchl 240 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchld =', wchld 241 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchldm =', wchldm 242 WRITE(numout,*) ' phytoplankton mortality rate mprat =', mprat 243 WRITE(numout,*) ' Diatoms mortality rate mprat2 =', mprat2 244 244 ENDIF 245 245 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r9125 r9169 4 4 !! TOP - PISCES : Compute the light availability in the water column 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 9 !! 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisation 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 10 10 !!---------------------------------------------------------------------- 11 11 !! p4z_opt : light availability in the water column … … 15 15 USE sms_pisces ! Source Minus Sink of PISCES 16 16 USE iom ! I/O manager 17 USE fldread 18 USE prtctl_trc 17 USE fldread ! time interpolation 18 USE prtctl_trc ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 27 27 !! * Shared module variables 28 28 29 LOGICAL :: ln_varpar !:boolean for variable PAR fraction30 REAL(wp) :: parlux !:Fraction of shortwave as PAR31 REAL(wp) :: xparsw !:parlux/332 REAL(wp) :: xsi0r !:1. /rn_si029 LOGICAL :: ln_varpar ! boolean for variable PAR fraction 30 REAL(wp) :: parlux ! Fraction of shortwave as PAR 31 REAL(wp) :: xparsw ! parlux/3 32 REAL(wp) :: xsi0r ! 1. /rn_si0 33 33 34 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par 35 35 INTEGER , PARAMETER :: nbtimes = 366 !: maximum number of times record in a file 36 36 INTEGER :: ntimes_par ! number of time steps in a file 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw !:PAR fraction of shortwave38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !:wavelength (Red-Green-Blue)37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 39 39 40 40 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 41 41 42 REAL(wp), DIMENSION(3,61) :: xkrgb ! :tabulated attenuation coefficients for RGB absorption42 REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption 43 43 44 44 !!---------------------------------------------------------------------- … … 70 70 !!--------------------------------------------------------------------- 71 71 ! 72 IF( ln_timing ) CALL timing_start('p4z_opt') 73 ! 74 ! Allocate temporary workspace 75 IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 76 77 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 72 IF( ln_timing ) CALL timing_start('p4z_opt') 73 IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 74 75 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 78 76 79 77 ! Initialisation of variables used to compute PAR … … 84 82 ! 85 83 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 86 87 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)88 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:)+ trb(:,:,:,jppch)84 ! ! -------------------------------------------------------- 85 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 86 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 89 87 ! 90 88 DO jk = 1, jpkm1 … … 105 103 IF( l_trcdm2dc ) THEN ! diurnal cycle 106 104 ! 107 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. -fr_i(:,:) + rtrn )105 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 108 106 ! 109 107 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) … … 120 118 ENDIF 121 119 ! 122 zqsr_corr(:,:) = qsr(:,:) / ( 1. -fr_i(:,:) + rtrn )120 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 123 121 ! 124 122 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) … … 130 128 ELSE 131 129 ! 132 zqsr_corr(:,:) = qsr(:,:) / ( 1. -fr_i(:,:) + rtrn )130 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 133 131 ! 134 132 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) … … 240 238 ENDIF 241 239 ! 242 IF( ln_p5z ) DEALLOCATE( zetmp5 ) 243 ! 244 IF( ln_timing ) CALL timing_stop('p4z_opt') 240 IF( ln_p5z ) DEALLOCATE( zetmp5 ) 241 IF( ln_timing ) CALL timing_stop('p4z_opt') 245 242 ! 246 243 END SUBROUTINE p4z_opt … … 255 252 !! 256 253 !!---------------------------------------------------------------------- 257 !! * arguments 258 INTEGER, INTENT(in) :: kt ! ocean time-step 259 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 260 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 261 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 262 REAL(wp), DIMENSION(jpi,jpj) , INTENT(out) , OPTIONAL :: pqsr100 263 !! * local variables 254 INTEGER , INTENT(in) :: kt ! ocean time-step 255 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave 256 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 257 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 ! 258 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out), OPTIONAL :: pqsr100 ! 259 ! 264 260 INTEGER :: ji, jj, jk ! dummy loop indices 265 REAL(wp), DIMENSION(jpi,jpj) :: zqsr !shortwave261 REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave 266 262 !!---------------------------------------------------------------------- 267 263 … … 272 268 273 269 ! Light at the euphotic depth 274 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)270 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 275 271 276 272 IF( PRESENT( pe0 ) ) THEN ! W-level … … 285 281 DO ji = 1, jpi 286 282 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 287 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ))288 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ))289 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ))283 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 284 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) 285 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) 290 286 END DO 291 287 ! … … 327 323 !! 328 324 !!---------------------------------------------------------------------- 329 INTEGER , INTENT(in) :: kt! ocean time step325 INTEGER, INTENT(in) :: kt ! ocean time step 330 326 ! 331 327 INTEGER :: ji,jj … … 357 353 !! ** Input : external ascii and netcdf files 358 354 !!---------------------------------------------------------------------- 359 INTEGER :: numpar 360 INTEGER :: ierr 361 INTEGER :: ios ! Local integer output status for namelist read 362 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 355 INTEGER :: numpar, ierr, ios ! Local integer 356 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 363 357 ! 364 358 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files … … 367 361 NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux 368 362 !!---------------------------------------------------------------------- 369 363 IF(lwp) THEN 364 WRITE(numout,*) 365 WRITE(numout,*) 'p4z_opt_init : ' 366 WRITE(numout,*) '~~~~~~~~~~~~ ' 367 ENDIF 370 368 REWIND( numnatp_ref ) ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR 371 369 READ ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 372 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 373 370 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 374 371 REWIND( numnatp_cfg ) ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR 375 372 READ ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 376 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp )373 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp ) 377 374 IF(lwm) WRITE ( numonp, nampisopt ) 378 375 379 376 IF(lwp) THEN 380 WRITE(numout,*) ' ' 381 WRITE(numout,*) ' namelist : nampisopt ' 382 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 383 WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar 384 WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux 377 WRITE(numout,*) ' Namelist : nampisopt ' 378 WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar 379 WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux 385 380 ENDIF 386 381 ! … … 391 386 ! ---------------------------------------- 392 387 IF( ln_varpar ) THEN 393 IF(lwp) WRITE(numout,*) ' initialize variable par fraction '394 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'388 IF(lwp) WRITE(numout,*) 389 IF(lwp) WRITE(numout,*) ' ==>>> initialize variable par fraction (ln_varpar=T)' 395 390 ! 396 391 ALLOCATE( par_varsw(jpi,jpj) ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r9125 r9169 23 23 PUBLIC p4z_poc ! called in p4zbio.F90 24 24 PUBLIC p4z_poc_init ! called in trcsms_pisces.F90 25 PUBLIC alngam 26 PUBLIC gamain 27 28 !! * Shared module variables 29 REAL(wp), PUBLIC :: xremip !: remineralisation rate of DOC 30 REAL(wp), PUBLIC :: xremipc !: remineralisation rate of DOC 31 REAL(wp), PUBLIC :: xremipn !: remineralisation rate of DON 32 REAL(wp), PUBLIC :: xremipp !: remineralisation rate of DOP 33 INTEGER , PUBLIC :: jcpoc !: number of lability classes 34 REAL(wp), PUBLIC :: rshape !: shape factor of the gamma distribution 35 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: alphan, reminp 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap 25 PUBLIC alngam ! 26 PUBLIC gamain ! 27 28 REAL(wp), PUBLIC :: xremip !: remineralisation rate of DOC 29 REAL(wp), PUBLIC :: xremipc !: remineralisation rate of DOC 30 REAL(wp), PUBLIC :: xremipn !: remineralisation rate of DON 31 REAL(wp), PUBLIC :: xremipp !: remineralisation rate of DOP 32 INTEGER , PUBLIC :: jcpoc !: number of lability classes 33 REAL(wp), PUBLIC :: rshape !: shape factor of the gamma distribution 34 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: alphan, reminp !: 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap !: 38 37 39 38 … … 53 52 !! ** Method : - ??? 54 53 !!--------------------------------------------------------------------- 55 ! 56 INTEGER, INTENT(in) :: kt, knt ! ocean time step 54 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 57 55 ! 58 56 INTEGER :: ji, jj, jk, jn … … 187 185 END DO 188 186 189 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )190 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )187 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 188 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 191 189 ENDIF 192 190 … … 260 258 ! ------------------------------------------------------------------- 261 259 ! 262 totprod (:,:) = 0.260 totprod (:,:) = 0. 263 261 totthick(:,:) = 0. 264 totcons (:,:) = 0.262 totcons (:,:) = 0. 265 263 ! intregrated production and consumption of POC in the mixed layer 266 264 ! ---------------------------------------------------------------- … … 396 394 END DO 397 395 398 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )399 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )396 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 397 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 400 398 ENDIF 401 399 … … 473 471 !! 474 472 !! ** Method : Read the nampispoc namelist and check the parameters 475 !! called at the first timestep473 !! called at the first timestep 476 474 !! 477 475 !! ** input : Namelist nampispoc 478 !!479 476 !!---------------------------------------------------------------------- 477 INTEGER :: jn ! dummy loop index 480 478 INTEGER :: ios, ifault ! Local integer 481 INTEGER :: jn 482 REAL(wp) :: remindelta, reminup, remindown 479 REAL(wp):: remindelta, reminup, remindown 483 480 !! 484 481 NAMELIST/nampispoc/ xremip , jcpoc , rshape, & 485 482 & xremipc, xremipn, xremipp 486 483 !!---------------------------------------------------------------------- 487 484 ! 485 IF(lwp) THEN 486 WRITE(numout,*) 487 WRITE(numout,*) 'p4z_poc_init : Initialization of remineralization parameters' 488 WRITE(numout,*) '~~~~~~~~~~~~' 489 ENDIF 490 ! 488 491 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization 489 492 READ ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 490 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 491 493 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 492 494 REWIND( numnatp_cfg ) ! Namelist nampisrem in configuration namelist : Pisces remineralization 493 495 READ ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 494 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp )495 IF(lwm) WRITE 496 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 497 IF(lwm) WRITE( numonp, nampispoc ) 496 498 497 499 IF(lwp) THEN ! control print 498 WRITE(numout,*) ' ' 499 WRITE(numout,*) ' Namelist parameters for remineralization, nampispoc' 500 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 500 WRITE(numout,*) ' Namelist : nampispoc' 501 501 IF( ln_p4z ) THEN 502 WRITE(numout,*) ' remineralisation rate of POC xremip =', xremip502 WRITE(numout,*) ' remineralisation rate of POC xremip =', xremip 503 503 ELSE 504 WRITE(numout,*) ' remineralisation rate of POC xremipc =', xremipc505 WRITE(numout,*) ' remineralisation rate of PON xremipn =', xremipn506 WRITE(numout,*) ' remineralisation rate of POP xremipp =', xremipp504 WRITE(numout,*) ' remineralisation rate of POC xremipc =', xremipc 505 WRITE(numout,*) ' remineralisation rate of PON xremipn =', xremipn 506 WRITE(numout,*) ' remineralisation rate of POP xremipp =', xremipp 507 507 ENDIF 508 WRITE(numout,*) ' Number of lability classes for POC jcpoc =', jcpoc509 WRITE(numout,*) ' Shape factor of the gamma distribution rshape =', rshape508 WRITE(numout,*) ' Number of lability classes for POC jcpoc =', jcpoc 509 WRITE(numout,*) ' Shape factor of the gamma distribution rshape =', rshape 510 510 ENDIF 511 511 ! … … 513 513 ! --------------------------------------- 514 514 ! 515 ALLOCATE( alphan(jcpoc), reminp(jcpoc) ) 516 ALLOCATE( alphap(jpi,jpj,jpk,jcpoc) ) 515 ALLOCATE( alphan(jcpoc) , reminp(jcpoc) , alphap(jpi,jpj,jpk,jcpoc) ) 517 516 ! 518 517 IF (jcpoc > 1) THEN … … 551 550 END SUBROUTINE p4z_poc_init 552 551 552 553 553 REAL FUNCTION alngam( xvalue, ifault ) 554 555 !*****************************************************************************80 556 ! 557 !! ALNGAM computes the logarithm of the gamma function. 558 ! 559 ! Modified: 560 ! 561 ! 13 January 2008 562 ! 563 ! Author: 564 ! 565 ! Allan Macleod 566 ! FORTRAN90 version by John Burkardt 567 ! 568 ! Reference: 569 ! 570 ! Allan Macleod, 571 ! Algorithm AS 245, 572 ! A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 573 ! Applied Statistics, 574 ! Volume 38, Number 2, 1989, pages 397-402. 575 ! 576 ! Parameters: 577 ! 578 ! Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 579 ! 580 ! Output, integer ( kind = 4 ) IFAULT, error flag. 581 ! 0, no error occurred. 582 ! 1, XVALUE is less than or equal to 0. 583 ! 2, XVALUE is too big. 584 ! 585 ! Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 586 ! 554 !*****************************************************************************80 555 ! 556 !! ALNGAM computes the logarithm of the gamma function. 557 ! 558 ! Modified: 13 January 2008 559 ! 560 ! Author : Allan Macleod 561 ! FORTRAN90 version by John Burkardt 562 ! 563 ! Reference: 564 ! Allan Macleod, Algorithm AS 245, 565 ! A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 566 ! Applied Statistics, 567 ! Volume 38, Number 2, 1989, pages 397-402. 568 ! 569 ! Parameters: 570 ! 571 ! Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 572 ! 573 ! Output, integer ( kind = 4 ) IFAULT, error flag. 574 ! 0, no error occurred. 575 ! 1, XVALUE is less than or equal to 0. 576 ! 2, XVALUE is too big. 577 ! 578 ! Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 579 !*****************************************************************************80 587 580 implicit none 588 581 … … 746 739 END FUNCTION alngam 747 740 741 748 742 REAL FUNCTION gamain( x, p, ifault ) 749 750 743 !*****************************************************************************80 751 744 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r9125 r9169 8 8 !! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation 9 9 !!---------------------------------------------------------------------- 10 !! p4z_prod : 11 !! p4z_prod_init : 12 !! p4z_prod_alloc : 10 !! p4z_prod : Compute the growth Rate of the two phytoplanktons groups 11 !! p4z_prod_init : Initialization of the parameters for growth 12 !! p4z_prod_alloc : Allocate variables for growth 13 13 !!---------------------------------------------------------------------- 14 USE oce_trc ! 15 USE trc ! 16 USE sms_pisces ! 17 USE p4zlim ! 18 USE prtctl_trc ! 19 USE iom ! 14 USE oce_trc ! shared variables between ocean and passive tracers 15 USE trc ! passive tracers common variables 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE p4zlim ! Co-limitations of differents nutrients 18 USE prtctl_trc ! print control for debugging 19 USE iom ! I/O manager 20 20 21 21 IMPLICIT NONE … … 26 26 PUBLIC p4z_prod_alloc 27 27 28 !! * Shared module variables 29 LOGICAL , PUBLIC :: ln_newprod !: 30 REAL(wp), PUBLIC :: pislopen !: 31 REAL(wp), PUBLIC :: pisloped !: 32 REAL(wp), PUBLIC :: xadap !: 33 REAL(wp), PUBLIC :: excretn !: 34 REAL(wp), PUBLIC :: excretd !: 35 REAL(wp), PUBLIC :: bresp !: 36 REAL(wp), PUBLIC :: chlcnm !: 37 REAL(wp), PUBLIC :: chlcdm !: 38 REAL(wp), PUBLIC :: chlcmin !: 39 REAL(wp), PUBLIC :: fecnm !: 40 REAL(wp), PUBLIC :: fecdm !: 41 REAL(wp), PUBLIC :: grosip !: 28 LOGICAL , PUBLIC :: ln_newprod !: 29 REAL(wp), PUBLIC :: pislopen !: 30 REAL(wp), PUBLIC :: pisloped !: 31 REAL(wp), PUBLIC :: xadap !: 32 REAL(wp), PUBLIC :: excretn !: 33 REAL(wp), PUBLIC :: excretd !: 34 REAL(wp), PUBLIC :: bresp !: 35 REAL(wp), PUBLIC :: chlcnm !: 36 REAL(wp), PUBLIC :: chlcdm !: 37 REAL(wp), PUBLIC :: chlcmin !: 38 REAL(wp), PUBLIC :: fecnm !: 39 REAL(wp), PUBLIC :: fecdm !: 40 REAL(wp), PUBLIC :: grosip !: 42 41 43 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: optimal production = f(temperature) … … 45 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotad !: proxy of N quota in diatomee 46 45 47 REAL(wp) :: r1_rday !:1 / rday48 REAL(wp) :: texcretn !:1 - excretn49 REAL(wp) :: texcretd !:1 - excretd46 REAL(wp) :: r1_rday ! 1 / rday 47 REAL(wp) :: texcretn ! 1 - excretn 48 REAL(wp) :: texcretd ! 1 - excretd 50 49 51 50 !!---------------------------------------------------------------------- … … 65 64 !! ** Method : - ??? 66 65 !!--------------------------------------------------------------------- 67 INTEGER, INTENT(in) :: kt, knt66 INTEGER, INTENT(in) :: kt, knt ! 68 67 ! 69 68 INTEGER :: ji, jj, jk … … 475 474 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 476 475 ENDIF 477 !478 IF( ln_timing ) CALL timing_stop('p4z_prod')479 !476 ! 477 IF( ln_timing ) CALL timing_stop('p4z_prod') 478 ! 480 479 END SUBROUTINE p4z_prod 481 480 … … 492 491 !! ** input : Namelist nampisprod 493 492 !!---------------------------------------------------------------------- 494 INTEGER :: ios ! Local integer output status for namelist read493 INTEGER :: ios ! Local integer 495 494 ! 496 495 NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd, & 497 496 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 498 497 !!---------------------------------------------------------------------- 499 498 ! 499 IF(lwp) THEN ! control print 500 WRITE(numout,*) 501 WRITE(numout,*) 'p4z_prod_init : phytoplankton growth' 502 WRITE(numout,*) '~~~~~~~~~~~~~' 503 ENDIF 504 ! 500 505 REWIND( numnatp_ref ) ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 501 506 READ ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 502 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 503 507 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 504 508 REWIND( numnatp_cfg ) ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 505 509 READ ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 506 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp )507 IF(lwm) WRITE 510 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 511 IF(lwm) WRITE( numonp, namp4zprod ) 508 512 509 513 IF(lwp) THEN ! control print 510 WRITE(numout,*) ' ' 511 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 512 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 513 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 514 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 515 WRITE(numout,*) ' P-I slope pislopen =', pislopen 516 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 517 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 518 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 514 WRITE(numout,*) ' Namelist : namp4zprod' 515 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 516 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 517 WRITE(numout,*) ' P-I slope pislopen =', pislopen 518 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 519 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 520 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 519 521 IF( ln_newprod ) THEN 520 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp521 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin522 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 523 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 522 524 ENDIF 523 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped524 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm525 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm526 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm527 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm525 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 526 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 527 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm 528 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm 529 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 528 530 ENDIF 529 531 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r9125 r9169 29 29 PUBLIC p4z_rem_alloc 30 30 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 35 REAL(wp), PUBLIC :: xremik !: remineralisation rate of POC 36 REAL(wp), PUBLIC :: nitrif !: NH4 nitrification rate 37 REAL(wp), PUBLIC :: xsirem !: remineralisation rate of POC 38 REAL(wp), PUBLIC :: xsiremlab !: fast remineralisation rate of POC 39 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 40 REAL(wp), PUBLIC :: feratb !: Fe/C quota in bacteria 41 REAL(wp), PUBLIC :: xkferb !: Half-saturation constant for bacteria Fe/C 42 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 31 REAL(wp), PUBLIC :: xremikc !: remineralisation rate of DOC 32 REAL(wp), PUBLIC :: xremikn !: remineralisation rate of DON 33 REAL(wp), PUBLIC :: xremikp !: remineralisation rate of DOP 34 REAL(wp), PUBLIC :: xremik !: remineralisation rate of POC 35 REAL(wp), PUBLIC :: nitrif !: NH4 nitrification rate 36 REAL(wp), PUBLIC :: xsirem !: remineralisation rate of POC 37 REAL(wp), PUBLIC :: xsiremlab !: fast remineralisation rate of POC 38 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 39 REAL(wp), PUBLIC :: feratb !: Fe/C quota in bacteria 40 REAL(wp), PUBLIC :: xkferb !: Half-saturation constant for bacteria Fe/C 41 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 44 43 45 44 !!---------------------------------------------------------------------- … … 303 302 INTEGER :: ios ! Local integer output status for namelist read 304 303 !!---------------------------------------------------------------------- 305 304 ! 305 IF(lwp) THEN 306 WRITE(numout,*) 307 WRITE(numout,*) 'p4z_rem_init : Initialization of remineralization parameters' 308 WRITE(numout,*) '~~~~~~~~~~~~' 309 ENDIF 310 ! 306 311 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization 307 312 READ ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901) 308 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp ) 309 313 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp ) 310 314 REWIND( numnatp_cfg ) ! Namelist nampisrem in configuration namelist : Pisces remineralization 311 315 READ ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 ) 312 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp )313 IF(lwm) WRITE 316 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp ) 317 IF(lwm) WRITE( numonp, nampisrem ) 314 318 315 319 IF(lwp) THEN ! control print 316 WRITE(numout,*) ' ' 317 WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem' 318 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 320 WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem' 319 321 IF( ln_p4z ) THEN 320 WRITE(numout,*) ' remineralization rate of DOC xremik =', xremik322 WRITE(numout,*) ' remineralization rate of DOC xremik =', xremik 321 323 ELSE 322 WRITE(numout,*) ' remineralization rate of DOC xremikc =', xremikc323 WRITE(numout,*) ' remineralization rate of DON xremikn =', xremikn324 WRITE(numout,*) ' remineralization rate of DOP xremikp =', xremikp324 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 325 327 ENDIF 326 WRITE(numout,*) ' remineralization rate of Si xsirem =', xsirem327 WRITE(numout,*) ' fast remineralization rate of Si xsiremlab =', xsiremlab328 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab329 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif330 WRITE(numout,*) ' Bacterial Fe/C ratio feratb =', feratb331 WRITE(numout,*) ' Half-saturation constant for bact. Fe/C xkferb =', xkferb328 WRITE(numout,*) ' remineralization rate of Si xsirem =', xsirem 329 WRITE(numout,*) ' fast remineralization rate of Si xsiremlab =', xsiremlab 330 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab 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 332 334 ENDIF 333 335 ! 334 denitr 336 denitr(:,:,:) = 0._wp 335 337 ! 336 338 END SUBROUTINE p4z_rem_init -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r9124 r9169 21 21 PUBLIC p4z_sbc_init 22 22 23 LOGICAL , PUBLIC :: ln_dust !: boolean for dust input from the atmosphere 24 LOGICAL , PUBLIC :: ln_solub !: boolean for variable solubility of atmospheric iron 25 LOGICAL , PUBLIC :: ln_river !: boolean for river input of nutrients 26 LOGICAL , PUBLIC :: ln_ndepo !: boolean for atmospheric deposition of N 27 LOGICAL , PUBLIC :: ln_ironsed !: boolean for Fe input from sediments 28 LOGICAL , PUBLIC :: ln_hydrofe !: boolean for Fe input from hydrothermal vents 29 LOGICAL , PUBLIC :: ln_ironice !: boolean for Fe input from sea ice 30 REAL(wp), PUBLIC :: sedfeinput !: Coastal release of Iron 31 REAL(wp), PUBLIC :: dustsolub !: Solubility of the dust 32 REAL(wp), PUBLIC :: mfrac !: Mineral Content of the dust 33 REAL(wp), PUBLIC :: icefeinput !: Iron concentration in sea ice 34 REAL(wp), PUBLIC :: wdust !: Sinking speed of the dust 35 REAL(wp), PUBLIC :: nitrfix !: Nitrogen fixation rate 36 REAL(wp), PUBLIC :: diazolight !: Nitrogen fixation sensitivty to light 37 REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs 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 44 LOGICAL , PUBLIC :: ll_sbc 45 46 LOGICAL :: ll_solub 23 LOGICAL , PUBLIC :: ln_dust !: boolean for dust input from the atmosphere 24 LOGICAL , PUBLIC :: ln_solub !: boolean for variable solubility of atmospheric iron 25 LOGICAL , PUBLIC :: ln_river !: boolean for river input of nutrients 26 LOGICAL , PUBLIC :: ln_ndepo !: boolean for atmospheric deposition of N 27 LOGICAL , PUBLIC :: ln_ironsed !: boolean for Fe input from sediments 28 LOGICAL , PUBLIC :: ln_hydrofe !: boolean for Fe input from hydrothermal vents 29 LOGICAL , PUBLIC :: ln_ironice !: boolean for Fe input from sea ice 30 REAL(wp), PUBLIC :: sedfeinput !: Coastal release of Iron 31 REAL(wp), PUBLIC :: dustsolub !: Solubility of the dust 32 REAL(wp), PUBLIC :: mfrac !: Mineral Content of the dust 33 REAL(wp), PUBLIC :: icefeinput !: Iron concentration in sea ice 34 REAL(wp), PUBLIC :: wdust !: Sinking speed of the dust 35 REAL(wp), PUBLIC :: nitrfix !: Nitrogen fixation rate 36 REAL(wp), PUBLIC :: diazolight !: Nitrogen fixation sensitivty to light 37 REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs 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 LOGICAL , PUBLIC :: ll_sbc 44 LOGICAL :: ll_solub 47 45 48 46 INTEGER , PARAMETER :: jpriv = 7 !: Maximum number of river input fields … … 55 53 INTEGER , PARAMETER :: jr_dsi = 7 !: index of dissolved silicate 56 54 57 58 55 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_solub 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_river ! structure of input riverdic56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_solub ! structure of input dust 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_river ! structure of input riverdic 61 58 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ndepo ! structure of input nitrogen deposition 62 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ironsed ! structure of input iron from sediment 63 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_hydrofe ! structure of input iron from hydrothermal vents 64 61 65 INTEGER , PARAMETER :: nbtimes = 365 !:maximum number of times record in a file66 INTEGER :: ntimes_dust, ntimes_riv, ntimes_ndep! number of time steps in a file67 INTEGER :: ntimes_solub, ntimes_hydro! number of time steps in a file68 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust, solub!: dust fields70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdic, rivalk!: river input fields71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdin, rivdip!: river input fields72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdon, rivdop!: river input fields73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdoc!: river input fields74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdsi!: river input fields75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep!: atmospheric N deposition76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed!: Coastal supply of iron77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe!: Hydrothermal vent supply of iron78 79 REAL(wp), PUBLIC :: sumdepsi, rivalkinput, rivdicinput, nitdepinput80 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput62 INTEGER , PARAMETER :: nbtimes = 365 ! maximum number of times record in a file 63 INTEGER :: ntimes_dust, ntimes_riv, ntimes_ndep ! number of time steps in a file 64 INTEGER :: ntimes_solub, ntimes_hydro ! number of time steps in a file 65 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust , solub !: dust fields 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdic, rivalk !: river input fields 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdin, rivdip !: river input fields 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdon, rivdop !: river input fields 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdoc !: river input fields 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdsi !: river input fields 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep !: atmospheric N deposition 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed !: Coastal supply of iron 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe !: Hydrothermal vent supply of iron 75 76 REAL(wp), PUBLIC :: rivalkinput, rivdicinput, nitdepinput, sumdepsi 77 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 81 78 82 79 !! * Substitutions … … 100 97 !! 101 98 !!---------------------------------------------------------------------- 102 !! * arguments 103 INTEGER, INTENT( in ) :: kt ! ocean time step 104 105 !! * local declarations 106 INTEGER :: ji,jj 107 REAL(wp) :: zcoef, zyyss 99 INTEGER, INTENT(in) :: kt ! ocean time step 100 ! 101 INTEGER :: ji, jj 102 REAL(wp) :: zcoef, zyyss 108 103 !!--------------------------------------------------------------------- 109 104 ! 110 IF( ln_timing ) CALL timing_start('p4z_sbc')105 IF( ln_timing ) CALL timing_start('p4z_sbc') 111 106 ! 112 107 ! Compute dust at nit000 or only if there is more than 1 time record in dust file … … 114 109 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 115 110 CALL fld_read( kt, 1, sf_dust ) 116 IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 117 dust(:,:) = sf_dust(1)%fnow(:,:,1) 118 ELSE 119 dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 111 IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN ; dust(:,:) = sf_dust(1)%fnow(:,:,1) 112 ELSE ; dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) 120 113 ENDIF 121 114 ENDIF 122 115 ENDIF 123 116 ! 124 117 IF( ll_solub ) THEN 125 118 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN … … 205 198 !! 206 199 !!---------------------------------------------------------------------- 207 !208 200 INTEGER :: ji, jj, jk, jm, ifpr 209 201 INTEGER :: ii0, ii1, ij0, ij1 … … 224 216 TYPE(FLD_N) :: sn_riverdoc, sn_riverdic, sn_riverdsi ! informations about the fields to be read 225 217 TYPE(FLD_N) :: sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop 226 ! 218 !! 227 219 NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon, & 228 220 & sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & … … 232 224 !!---------------------------------------------------------------------- 233 225 ! 226 IF(lwp) THEN 227 WRITE(numout,*) 228 WRITE(numout,*) 'p4z_sbc_init : initialization of the external sources of nutrients ' 229 WRITE(numout,*) '~~~~~~~~~~~~ ' 230 ENDIF 234 231 ! !* set file information 235 232 REWIND( numnatp_ref ) ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients 236 233 READ ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901) 237 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp ) 238 234 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp ) 239 235 REWIND( numnatp_cfg ) ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients 240 236 READ ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 ) 241 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )237 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp ) 242 238 IF(lwm) WRITE ( numonp, nampissbc ) 243 239 244 IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN 240 IF(lwp) THEN 241 WRITE(numout,*) ' Namelist : nampissbc ' 242 WRITE(numout,*) ' dust input from the atmosphere ln_dust = ', ln_dust 243 WRITE(numout,*) ' Variable solubility of iron input ln_solub = ', ln_solub 244 WRITE(numout,*) ' river input of nutrients ln_river = ', ln_river 245 WRITE(numout,*) ' atmospheric deposition of n ln_ndepo = ', ln_ndepo 246 WRITE(numout,*) ' Fe input from sediments ln_ironsed = ', ln_ironsed 247 WRITE(numout,*) ' Fe input from seaice ln_ironice = ', ln_ironice 248 WRITE(numout,*) ' fe input from hydrothermal vents ln_hydrofe = ', ln_hydrofe 249 WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput 250 WRITE(numout,*) ' solubility of the dust dustsolub = ', dustsolub 251 WRITE(numout,*) ' Mineral Fe content of the dust mfrac = ', mfrac 252 WRITE(numout,*) ' Iron concentration in sea ice icefeinput = ', icefeinput 253 WRITE(numout,*) ' sinking speed of the dust wdust = ', wdust 254 WRITE(numout,*) ' nitrogen fixation rate nitrfix = ', nitrfix 255 WRITE(numout,*) ' nitrogen fixation sensitivty to light diazolight = ', diazolight 256 WRITE(numout,*) ' Fe half-saturation cste for diazotrophs concfediaz = ', concfediaz 257 WRITE(numout,*) ' Fe to 3He ratio assumed for vent iron supply hratio = ', hratio 258 IF( ln_ligand ) THEN 259 WRITE(numout,*) ' Fep/Fer ratio from sed sources fep_rats = ', fep_rats 260 WRITE(numout,*) ' Fep/Fer ratio from sed hydro sources fep_rath = ', fep_rath 261 WRITE(numout,*) ' Weak ligand ratio from sed hydro sources lgw_rath = ', lgw_rath 262 ENDIF 263 END IF 264 265 IF( nn_ice_tr >= 0 .AND. ln_ironice ) THEN 245 266 IF(lwp) THEN 246 WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 247 WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead ' 248 WRITE(numout,*) ' ln_ironice is forced to .FALSE. ' 249 ln_ironice = .FALSE. 250 ENDIF 251 ENDIF 252 253 IF(lwp) THEN 254 WRITE(numout,*) ' ' 255 WRITE(numout,*) ' namelist : nampissbc ' 256 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 257 WRITE(numout,*) ' dust input from the atmosphere ln_dust = ', ln_dust 258 WRITE(numout,*) ' Variable solubility of iron input ln_solub = ', ln_solub 259 WRITE(numout,*) ' river input of nutrients ln_river = ', ln_river 260 WRITE(numout,*) ' atmospheric deposition of n ln_ndepo = ', ln_ndepo 261 WRITE(numout,*) ' Fe input from sediments ln_ironsed = ', ln_ironsed 262 WRITE(numout,*) ' Fe input from seaice ln_ironice = ', ln_ironice 263 WRITE(numout,*) ' fe input from hydrothermal vents ln_hydrofe = ', ln_hydrofe 264 WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput 265 WRITE(numout,*) ' solubility of the dust dustsolub = ', dustsolub 266 WRITE(numout,*) ' Mineral Fe content of the dust mfrac = ', mfrac 267 WRITE(numout,*) ' Iron concentration in sea ice icefeinput = ', icefeinput 268 WRITE(numout,*) ' sinking speed of the dust wdust = ', wdust 269 WRITE(numout,*) ' nitrogen fixation rate nitrfix = ', nitrfix 270 WRITE(numout,*) ' nitrogen fixation sensitivty to light diazolight = ', diazolight 271 WRITE(numout,*) ' fe half-saturation cste for diazotrophs concfediaz = ', concfediaz 272 WRITE(numout,*) ' Fe to 3He ratio assumed for vent iron supply hratio = ', hratio 273 IF( ln_ligand ) THEN 274 WRITE(numout,*) ' Fep/Fer ratio from sed sources fep_rats = ', fep_rats 275 WRITE(numout,*) ' Fep/Fer ratio from sed hydro sources fep_rath = ', fep_rath 276 WRITE(numout,*) ' Weak ligand ratio from sed hydro sources lgw_rath = ', lgw_rath 277 ENDIF 278 END IF 279 280 IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN ; ll_sbc = .TRUE. 281 ELSE ; ll_sbc = .FALSE. 282 ENDIF 283 284 IF( ln_dust .AND. ln_solub ) THEN ; ll_solub = .TRUE. 285 ELSE ; ll_solub = .FALSE. 267 WRITE(numout,*) ' ==>>> ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 268 WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead ' 269 WRITE(numout,*) ' ln_ironice is forced to .FALSE. ' 270 ENDIF 271 ln_ironice = .FALSE. 272 ENDIF 273 274 IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN ; ll_sbc = .TRUE. 275 ELSE ; ll_sbc = .FALSE. 276 ENDIF 277 278 IF( ln_dust .AND. ln_solub ) THEN ; ll_solub = .TRUE. 279 ELSE ; ll_solub = .FALSE. 286 280 ENDIF 287 281 … … 322 316 DO jm = 1, ntimes_dust 323 317 sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust ) 324 END DO318 END DO 325 319 sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1 326 320 DEALLOCATE( zdust) … … 335 329 IF( ll_solub ) THEN 336 330 ! 337 IF(lwp) WRITE(numout,*) ' initialize variable solubility of Fe '338 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'331 IF(lwp) WRITE(numout,*) 332 IF(lwp) WRITE(numout,*) ' ==>>> ll_solub=T , initialize variable solubility of Fe ' 339 333 ! 340 334 ALLOCATE( solub(jpi,jpj) ) ! allocation … … 356 350 IF( ln_river ) THEN 357 351 ! 358 slf_river(jr_dic) = sn_riverdic ; slf_river(jr_doc) = sn_riverdoc ;slf_river(jr_din) = sn_riverdin359 slf_river(jr_don) = sn_riverdon ; slf_river(jr_dip) = sn_riverdip ;slf_river(jr_dop) = sn_riverdop352 slf_river(jr_dic) = sn_riverdic ; slf_river(jr_doc) = sn_riverdoc ; slf_river(jr_din) = sn_riverdin 353 slf_river(jr_don) = sn_riverdon ; slf_river(jr_dip) = sn_riverdip ; slf_river(jr_dop) = sn_riverdop 360 354 slf_river(jr_dsi) = sn_riverdsi 361 355 ! … … 363 357 IF( ln_p5z ) ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) ) 364 358 ! 365 ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 ) 366 rivinput(:) = 0. 0359 ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 ) !* allocate and fill sf_river (forcing structure) with sn_river_ 360 rivinput(:) = 0._wp 367 361 368 362 IF( ierr1 > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' ) … … 409 403 IF( ln_ndepo ) THEN 410 404 ! 411 IF(lwp) WRITE(numout,*) ' initialize the nutrient input by dust from ndeposition.orca.nc'412 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'405 IF(lwp) WRITE(numout,*) 406 IF(lwp) WRITE(numout,*) ' ==>>> ln_ndepo=T , initialize the nutrient input by dust from NetCDF file' 413 407 ! 414 408 ALLOCATE( nitdep(jpi,jpj) ) ! allocation … … 446 440 IF( ln_ironsed ) THEN 447 441 ! 448 IF(lwp) WRITE(numout,*) ' computation of an island mask to enhance coastal supply of iron'449 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'442 IF(lwp) WRITE(numout,*) 443 IF(lwp) WRITE(numout,*) ' ==>>> ln_ironsed=T , computation of an island mask to enhance coastal supply of iron' 450 444 ! 451 445 ALLOCATE( ironsed(jpi,jpj,jpk) ) ! allocation … … 458 452 ik50 = 5 ! last level where depth less than 50 m 459 453 DO jk = jpkm1, 1, -1 460 IF( gdept_1d(jk) > 50. ) ik50 = jk - 1454 IF( gdept_1d(jk) > 50. ) ik50 = jk - 1 461 455 END DO 462 IF (lwp) WRITE(numout,*) 463 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 464 IF (lwp) WRITE(numout,*) 456 IF(lwp) WRITE(numout,*) 457 IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 465 458 DO jk = 1, ik50 466 459 DO jj = 2, jpjm1 … … 499 492 IF( ln_hydrofe ) THEN 500 493 ! 501 IF(lwp) WRITE(numout,*) ' Input of iron from hydrothermal vents '502 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'494 IF(lwp) WRITE(numout,*) 495 IF(lwp) WRITE(numout,*) ' ==>>> ln_hydrofe=T , Input of iron from hydrothermal vents' 503 496 ! 504 497 ALLOCATE( hydrofe(jpi,jpj,jpk) ) ! allocation … … 521 514 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 522 515 WRITE(numout,*) ' N Supply : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr' 523 WRITE(numout,*) ' Si Supply : ', rivdsiinput*1E3/1E12*28.1 ,' TgSi/yr'516 WRITE(numout,*) ' Si Supply : ', rivdsiinput*1E3/1E12*28.1 ,' TgSi/yr' 524 517 WRITE(numout,*) ' P Supply : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr' 525 WRITE(numout,*) ' Alk Supply : ', rivalkinput*1E3/1E12 ,' Teq/yr'526 WRITE(numout,*) ' DIC Supply : ', rivdicinput*1E3*12./1E12 ,'TgC/yr'518 WRITE(numout,*) ' Alk Supply : ', rivalkinput*1E3/1E12 ,' Teq/yr' 519 WRITE(numout,*) ' DIC Supply : ', rivdicinput*1E3*12./1E12 ,' TgC/yr' 527 520 WRITE(numout,*) 528 521 WRITE(numout,*) ' Total input of elements from atmospheric supply' -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r9125 r9169 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 !! p4z sms :Time loop of passive tracers sms9 !! p4z_sms : Time loop of passive tracers sms 10 10 !!---------------------------------------------------------------------- 11 USE oce_trc ! 12 USE trc ! 13 USE trcdta 14 USE sms_pisces ! 15 USE p4zbio ! 16 USE p4zche ! 17 USE p4zlys ! 18 USE p4zflx ! 19 USE p4zsbc ! 20 USE p4zsed ! 21 USE p4zint ! 22 USE p4zrem ! 23 USE iom ! 24 USE trd_oce ! 25 USE trdtrc ! 26 USE sedmodel ! 27 USE prtctl_trc ! 11 USE oce_trc ! shared variables between ocean and passive tracers 12 USE trc ! passive tracers common variables 13 USE trcdta ! 14 USE sms_pisces ! PISCES Source Minus Sink variables 15 USE p4zbio ! Biological model 16 USE p4zche ! Chemical model 17 USE p4zlys ! Calcite saturation 18 USE p4zflx ! Gas exchange 19 USE p4zsbc ! External source of nutrients 20 USE p4zsed ! Sedimentation 21 USE p4zint ! time interpolation 22 USE p4zrem ! remineralisation 23 USE iom ! I/O manager 24 USE trd_oce ! Ocean trends variables 25 USE trdtrc ! TOP trends variables 26 USE sedmodel ! Sediment model 27 USE prtctl_trc ! print control for debugging 28 28 29 29 IMPLICIT NONE … … 33 33 PUBLIC p4z_sms ! called in p4zsms.F90 34 34 35 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 36 REAL(wp) :: xfact1, xfact2, xfact3 37 INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget 38 39 !!* Array used to indicate negative tracer values 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ??? 35 INTEGER :: numco2, numnut, numnit ! logical unit for co2 budget 36 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 37 REAL(wp) :: xfact1, xfact2, xfact3 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values 41 40 42 41 !!---------------------------------------------------------------------- … … 45 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 45 !!---------------------------------------------------------------------- 47 48 46 CONTAINS 49 47 … … 197 195 NAMELIST/nampismass/ ln_check_mass 198 196 !!---------------------------------------------------------------------- 197 ! 198 IF(lwp) THEN 199 WRITE(numout,*) 200 WRITE(numout,*) 'p4z_sms_init : PISCES initialization' 201 WRITE(numout,*) '~~~~~~~~~~~~' 202 ENDIF 199 203 200 204 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables 201 205 READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 202 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 203 206 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 204 207 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables 205 208 READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 206 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp )207 IF(lwm) WRITE 208 209 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp ) 210 IF(lwm) WRITE( numonp, nampisbio ) 211 ! 209 212 IF(lwp) THEN ! control print 210 WRITE(numout,*) ' Namelist : nampisbio'211 WRITE(numout,*) ' frequence pour la biologie nrdttrc=', nrdttrc212 WRITE(numout,*) ' POC sinking speed wsbio=', wsbio213 WRITE(numout,*) ' half saturation constant for mortality xkmort=', xkmort213 WRITE(numout,*) ' Namelist : nampisbio' 214 WRITE(numout,*) ' frequency for the biology nrdttrc =', nrdttrc 215 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio 216 WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort 214 217 IF( ln_p5z ) THEN 215 WRITE(numout,*) ' N/C in zooplankton no3rat3=', no3rat3216 WRITE(numout,*) ' P/C in zooplankton po4rat3=', po4rat3217 ENDIF 218 WRITE(numout,*) ' Fe/C in zooplankton ferat3=', ferat3219 WRITE(numout,*) ' Big particles sinking speed wsbio2=', wsbio2220 WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max=', wsbio2max221 WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale222 WRITE(numout,*) ' Maximum number of iterations for POC niter1max=', niter1max223 WRITE(numout,*) ' Maximum number of iterations for GOC niter2max=', niter2max218 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 225 WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max 226 WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max 224 227 IF( ln_ligand ) THEN 225 WRITE(numout,*) ' FeP sinking speedwfep =', wfep228 WRITE(numout,*) ' FeP sinking speed wfep =', wfep 226 229 IF( ln_p4z ) THEN 227 WRITE(numout,*) ' Phyto ligand production per unit docldocp =', ldocp228 WRITE(numout,*) ' Zoo ligand production per unit docldocz =', ldocz229 WRITE(numout,*) ' Proportional loss of ligands due to Fe uptakelthet =', lthet230 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 230 233 ENDIF 231 234 ENDIF … … 235 238 REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping 236 239 READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 237 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 238 240 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 239 241 REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping 240 242 READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 241 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp )242 IF(lwm) WRITE 243 243 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp ) 244 IF(lwm) WRITE( numonp, nampisdmp ) 245 ! 244 246 IF(lwp) THEN ! control print 245 247 WRITE(numout,*) 246 WRITE(numout,*) ' Namelist : nampisdmp' 247 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 248 WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp 249 WRITE(numout,*) ' ' 248 WRITE(numout,*) ' Namelist : nampisdmp --- relaxation to GLODAP' 249 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 250 WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp 250 251 ENDIF 251 252 252 253 REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check 253 254 READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 254 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 255 255 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 256 256 REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check 257 257 READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 258 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp )259 IF(lwm) WRITE 258 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp ) 259 IF(lwm) WRITE( numonp, nampismass ) 260 260 261 261 IF(lwp) THEN ! control print 262 WRITE(numout,*) ' ' 263 WRITE(numout,*) ' Namelist parameter for mass conservation checking' 264 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 265 WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 262 WRITE(numout,*) 263 WRITE(numout,*) ' Namelist : nampismass --- mass conservation checking' 264 WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 266 265 ENDIF 267 266 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r7753 r9169 37 37 !! ** Purpose : Initialisation of the PISCES biochemical model 38 38 !!---------------------------------------------------------------------- 39 40 39 ! 41 40 CALL trc_nam_pisces … … 46 45 47 46 END SUBROUTINE trc_ini_pisces 47 48 48 49 49 SUBROUTINE p4z_ini … … 53 53 !! ** Purpose : Initialisation of the PISCES biochemical model 54 54 !!---------------------------------------------------------------------- 55 !56 55 USE p4zsms ! Main P4Z routine 57 56 USE p4zche ! Chemical model … … 76 75 USE p5zmeso ! Sources and sinks of mesozooplankton 77 76 USE p5zmort ! Mortality terms for phytoplankton 78 79 ! 80 REAL(wp), SAVE :: sco2 = 2.312e-3_wp 81 REAL(wp), SAVE :: alka0 = 2.426e-3_wp 82 REAL(wp), SAVE :: oxyg0 = 177.6e-6_wp 83 REAL(wp), SAVE :: po4 = 2.165e-6_wp 84 REAL(wp), SAVE :: bioma0 = 1.000e-8_wp 85 REAL(wp), SAVE :: silic1 = 91.51e-6_wp 86 REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp 77 ! 78 REAL(wp), SAVE :: sco2 = 2.312e-3_wp 79 REAL(wp), SAVE :: alka0 = 2.426e-3_wp 80 REAL(wp), SAVE :: oxyg0 = 177.6e-6_wp 81 REAL(wp), SAVE :: po4 = 2.165e-6_wp 82 REAL(wp), SAVE :: bioma0 = 1.000e-8_wp 83 REAL(wp), SAVE :: silic1 = 91.51e-6_wp 84 REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp 87 85 ! 88 86 INTEGER :: ji, jj, jk, jn, ierr … … 90 88 REAL(wp) :: ztmas, ztmas1 91 89 CHARACTER(len = 20) :: cltra 92 93 !!---------------------------------------------------------------------- 94 90 !!---------------------------------------------------------------------- 91 ! 95 92 IF(lwp) THEN 96 93 WRITE(numout,*) 97 94 IF( ln_p4z ) THEN 98 WRITE(numout,*) ' p4z_ini : PISCES biochemical model initialisation' 95 WRITE(numout,*) 'p4z_ini : PISCES biochemical model initialisation' 96 WRITE(numout,*) '~~~~~~~' 99 97 ELSE 100 WRITE(numout,*) ' 101 WRITE(numout,*) ' 98 WRITE(numout,*) 'p5z_ini : PISCES biochemical model initialisation' 99 WRITE(numout,*) '~~~~~~~ With variable stoichiometry' 102 100 ENDIF 103 WRITE(numout,*) ' ~~~~~~~~~~~~~~'104 101 ENDIF 105 102 ! … … 170 167 IF( cltra == 'LGW' ) jplgw = jn !: Weak ligands 171 168 IF( cltra == 'LFe' ) jpfep = jn !: Fe nanoparticle 172 END DO169 END DO 173 170 174 171 CALL p4z_sms_init ! Maint routine 175 ! ! Time-step172 ! 176 173 177 174 ! Set biological ratios … … 275 272 276 273 IF(lwp) WRITE(numout,*) 277 IF(lwp) WRITE(numout,*) ' Initialization of PISCES tracers done'274 IF(lwp) WRITE(numout,*) ' ==>>> Initialization of PISCES tracers done' 278 275 IF(lwp) WRITE(numout,*) 279 276 ! 280 277 END SUBROUTINE p4z_ini 278 281 279 282 280 SUBROUTINE p2z_ini … … 298 296 IF(lwp) WRITE(numout,*) 299 297 IF(lwp) WRITE(numout,*) ' p2z_ini : LOBSTER biochemical model initialisation' 300 IF(lwp) WRITE(numout,*) ' ~~~~~~~ ~~~~~~~'298 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 301 299 302 300 ierr = sms_pisces_alloc() … … 346 344 ! 347 345 IF(lwp) WRITE(numout,*) 348 IF(lwp) WRITE(numout,*) ' Initialization of LOBSTER tracers done'346 IF(lwp) WRITE(numout,*) ' ==>>> Initialization of LOBSTER tracers done' 349 347 IF(lwp) WRITE(numout,*) 350 348 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r9124 r9169 9 9 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) from trcnam.pisces.h90 10 10 !!---------------------------------------------------------------------- 11 !! trc_nam_pisces 11 !! trc_nam_pisces : PISCES model namelist read 12 12 !!---------------------------------------------------------------------- 13 13 USE oce_trc ! Ocean variables … … 40 40 !!---------------------------------------------------------------------- 41 41 INTEGER :: jl, jn 42 INTEGER :: ios, ioptio ! Local integer output status for namelist read43 CHARACTER(LEN=20) 42 INTEGER :: ios, ioptio ! Local integer 43 CHARACTER(LEN=20):: clname 44 44 !! 45 45 NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand … … 49 49 clname = 'namelist_pisces' 50 50 51 IF(lwp) WRITE(numout,*) ' 52 IF(lwp) WRITE(numout,*) ' 51 IF(lwp) WRITE(numout,*) 'trc_nam_pisces : read PISCES namelist' 52 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 53 53 CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 54 54 CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 55 55 IF(lwm) CALL ctl_opn( numonp , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 56 56 ! 57 58 57 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables 59 58 READ ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 60 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 61 59 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 62 60 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables 63 61 READ ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 64 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 65 IF(lwm) WRITE ( numonp, nampismod ) 66 67 IF(lwp) THEN ! control print 68 WRITE(numout,*) ' ' 69 WRITE(numout,*) ' Flag to use LOBSTER model ln_p2z = ', ln_p2z 70 WRITE(numout,*) ' Flag to use PISCES standard model ln_p4z = ', ln_p4z 71 WRITE(numout,*) ' Flag to use PISCES quota model ln_p5z = ', ln_p5z 72 WRITE(numout,*) ' Flag to ligand ln_ligand = ', ln_ligand 73 WRITE(numout,*) ' ' 62 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 63 IF(lwm) WRITE( numonp, nampismod ) 64 ! 65 IF(lwp) THEN ! control print 66 WRITE(numout,*) ' Namelist : nampismod ' 67 WRITE(numout,*) ' Flag to use LOBSTER model ln_p2z = ', ln_p2z 68 WRITE(numout,*) ' Flag to use PISCES standard model ln_p4z = ', ln_p4z 69 WRITE(numout,*) ' Flag to use PISCES quota model ln_p5z = ', ln_p5z 70 WRITE(numout,*) ' Flag to ligand ln_ligand = ', ln_ligand 74 71 ENDIF 75 72 ! 76 73 IF(lwp) THEN ! control print 77 WRITE(numout,*) ' ' 78 IF( ln_p5z ) WRITE(numout,*) ' PISCES QUOTA model is used' 79 IF( ln_p4z ) WRITE(numout,*) ' PISCES STANDARD model is used' 80 IF( ln_p2z ) WRITE(numout,*) ' LOBSTER model is used' 81 IF( ln_ligand ) WRITE(numout,*) ' Compute remineralization/dissolution of organic ligands' 82 WRITE(numout,*) ' ' 74 WRITE(numout,*) 75 IF( ln_p5z ) WRITE(numout,*) ' ==>>> PISCES QUOTA model is used' 76 IF( ln_p4z ) WRITE(numout,*) ' ==>>> PISCES STANDARD model is used' 77 IF( ln_p2z ) WRITE(numout,*) ' ==>>> LOBSTER model is used' 78 IF( ln_ligand ) WRITE(numout,*) ' ==>>> Compute remineralization/dissolution of organic ligands' 83 79 ENDIF 84 80 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r9019 r9169 153 153 !! passive tracer advection schemes and set nadv 154 154 !!---------------------------------------------------------------------- 155 INTEGER :: ioptio 156 INTEGER :: ios ! Local integer output status for namelist read 155 INTEGER :: ioptio, ios ! Local integer 157 156 !! 158 157 NAMELIST/namtrc_adv/ ln_trcadv_NONE, & ! No advection … … 167 166 REWIND( numnat_ref ) ! namtrc_adv in reference namelist 168 167 READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 169 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 170 ! 168 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 171 169 REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist 172 170 READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 173 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )171 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 174 172 IF(lwm) WRITE ( numont, namtrc_adv ) 175 173 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r9125 r9169 20 20 USE trcdta 21 21 USE tradmp 22 USE prtctl_trc ! Print control for debbuging23 22 USE trdtra 24 23 USE trd_oce 24 ! 25 25 USE iom 26 USE prtctl_trc ! Print control for debbuging 26 27 27 28 IMPLICIT NONE … … 33 34 PUBLIC trc_dmp_ini 34 35 35 INTEGER , PUBLIC :: nn_zdmp_tr != 0/1/2 flag for damping in the mixed layer36 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient36 INTEGER , PUBLIC :: nn_zdmp_tr !: = 0/1/2 flag for damping in the mixed layer 37 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !: File containing restoration coefficient 37 38 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 39 40 40 INTEGER, PARAMETER :: npncts = 8! number of closed sea41 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1! south-west closed sea limits (i,j)42 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2! north-east closed sea limits (i,j)41 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 42 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 43 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) 43 44 44 45 !! * Substitutions … … 182 183 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 183 184 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 184 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 185 185 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 186 186 REWIND( numnat_cfg ) ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 187 187 READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 188 910 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )188 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 189 189 IF(lwm) WRITE ( numont, namtrc_dmp ) 190 190 … … 194 194 WRITE(numout,*) '~~~~~~~' 195 195 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 196 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'197 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr196 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 197 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 198 198 ENDIF 199 199 ! ! Allocate arrays … … 201 201 ! 202 202 SELECT CASE ( nn_zdmp_tr ) 203 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column'204 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)'205 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'203 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' ===>> tracer damping throughout the water column' 204 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' ===>> no tracer damping in the turbocline (avt > 5 cm2/s)' 205 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' ===>> no tracer damping in the mixed layer' 206 206 CASE DEFAULT 207 207 WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr … … 210 210 211 211 IF( .NOT.lk_c1d ) THEN 212 IF( .NOT. 213 & CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' )212 IF( .NOT.ln_tradmp ) & 213 & CALL ctl_stop( 'passive tracer damping need ln_tradmp to compute damping coef.' ) 214 214 ! 215 215 ! ! Read damping coefficients from file … … 241 241 INTEGER :: isrow ! local index 242 242 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 243 244 243 !!---------------------------------------------------------------------- 245 244 … … 260 259 isrow = 332 - jpjglo 261 260 ! 262 ! Caspian Sea 263 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 261 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 264 262 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 265 ! ! Lake Superior266 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 263 ! 264 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 267 265 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 268 ! ! Lake Michigan269 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 266 ! 267 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 270 268 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 271 ! ! Lake Huron272 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 269 ! 270 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 273 271 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 274 ! ! Lake Erie275 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 272 ! 273 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 276 274 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 277 ! ! Lake Ontario278 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 275 ! 276 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 279 277 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 280 ! ! Victoria Lake281 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 278 ! 279 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 282 280 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 283 ! ! Baltic Sea284 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 281 ! 282 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 285 283 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 286 284 ! … … 288 286 CASE ( 2 ) ! ORCA_R2 configuration 289 287 ! ! ======================= 290 ! ! Caspian Sea291 nctsi1(1) = 11 ; nctsj1(1) = 103 288 ! 289 nctsi1(1) = 11 ; nctsj1(1) = 103 ! Caspian Sea 292 290 nctsi2(1) = 17 ; nctsj2(1) = 112 293 ! ! Great North American Lakes294 nctsi1(2) = 97 ; nctsj1(2) = 107 291 ! 292 nctsi1(2) = 97 ; nctsj1(2) = 107 ! Great North American Lakes 295 293 nctsi2(2) = 103 ; nctsj2(2) = 111 296 ! ! Black Sea 1 : west part of the Black Sea297 nctsi1(3) = 174 ; nctsj1(3) = 107 294 ! 295 nctsi1(3) = 174 ; nctsj1(3) = 107 ! Black Sea 1 : west part of the Black Sea 298 296 nctsi2(3) = 181 ; nctsj2(3) = 112 299 ! ! Black Sea 2 : est part of the Black Sea300 nctsi1(4) = 2 ; nctsj1(4) = 107 297 ! 298 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea 301 299 nctsi2(4) = 6 ; nctsj2(4) = 112 302 ! ! Baltic Sea303 nctsi1(5) = 145 ; nctsj1(5) = 116 300 ! 301 nctsi1(5) = 145 ; nctsj1(5) = 116 ! Baltic Sea 304 302 nctsi2(5) = 150 ; nctsj2(5) = 126 305 303 ! ! ======================= 306 304 CASE ( 4 ) ! ORCA_R4 configuration 307 305 ! ! ======================= 308 ! ! Caspian Sea309 nctsi1(1) = 4 ; nctsj1(1) = 53 306 ! 307 nctsi1(1) = 4 ; nctsj1(1) = 53 ! Caspian Sea 310 308 nctsi2(1) = 4 ; nctsj2(1) = 56 311 ! ! Great North American Lakes312 nctsi1(2) = 49 ; nctsj1(2) = 55 309 ! 310 nctsi1(2) = 49 ; nctsj1(2) = 55 ! Great North American Lakes 313 311 nctsi2(2) = 51 ; nctsj2(2) = 56 314 ! ! Black Sea315 nctsi1(3) = 88 ; nctsj1(3) = 55 312 ! 313 nctsi1(3) = 88 ; nctsj1(3) = 55 ! Black Sea 316 314 nctsi2(3) = 91 ; nctsj2(3) = 56 317 ! ! Baltic Sea318 nctsi1(4) = 75 ; nctsj1(4) = 59 315 ! 316 nctsi1(4) = 75 ; nctsj1(4) = 59 ! Baltic Sea 319 317 nctsi2(4) = 76 ; nctsj2(4) = 61 320 318 ! ! ======================= 321 319 CASE ( 025 ) ! ORCA_R025 configuration 322 320 ! ! ======================= 323 ! Caspian + Aral sea324 nctsi1(1) = 1330 ; nctsj1(1) = 645 321 ! 322 nctsi1(1) = 1330 ; nctsj1(1) = 645 ! Caspian + Aral sea 325 323 nctsi2(1) = 1400 ; nctsj2(1) = 795 326 ! ! Azov Sea327 nctsi1(2) = 1284 ; nctsj1(2) = 722 324 ! 325 nctsi1(2) = 1284 ; nctsj1(2) = 722 ! Azov Sea 328 326 nctsi2(2) = 1304 ; nctsj2(2) = 747 329 327 ! … … 332 330 ENDIF 333 331 ! 334 335 332 ! convert the position in local domain indices 336 333 ! -------------------------------------------- … … 338 335 nctsi1(jc) = mi0( nctsi1(jc) ) 339 336 nctsj1(jc) = mj0( nctsj1(jc) ) 340 337 ! 341 338 nctsi2(jc) = mi1( nctsi2(jc) ) 342 339 nctsj2(jc) = mj1( nctsj2(jc) ) … … 364 361 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 365 362 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 366 END DO367 END DO368 END DO369 END DO363 END DO 364 END DO 365 END DO 366 END DO 370 367 ENDIF 371 END DO368 END DO 372 369 DEALLOCATE( ztrcdta ) 373 370 ENDIF 374 371 ! 375 372 END SUBROUTINE trc_dmp_clo 376 377 373 378 374 #else -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r9125 r9169 152 152 REWIND( numnat_cfg ) ! namtrc_ldf in configuration namelist 153 153 READ ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 154 904 IF( ios /=0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )154 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 155 155 IF(lwm) WRITE ( numont, namtrc_ldf ) 156 156 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r9125 r9169 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- 34 35 34 CONTAINS 36 35 … … 50 49 !! (the total CFC content is not strictly preserved) 51 50 !!---------------------------------------------------------------------- 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index 51 INTEGER, INTENT(in) :: kt ! ocean time-step index 52 ! 53 53 CHARACTER (len=22) :: charout 54 54 !!---------------------------------------------------------------------- … … 56 56 IF( ln_timing ) CALL timing_start('trc_rad') 57 57 ! 58 IF( kt == nittrc000 ) THEN 59 IF(lwp) WRITE(numout,*) 60 IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 61 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 62 ENDIF 63 64 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE 58 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE 65 59 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 ) ! C1460 IF( ln_c14 ) CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14 ) ! C14 67 61 IF( ln_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model 68 62 IF( ln_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1 ) ! MY_TRC model 69 70 63 ! 71 64 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 79 72 END SUBROUTINE trc_rad 80 73 74 81 75 SUBROUTINE trc_rad_ini 82 76 !!--------------------------------------------------------------------- 83 77 !! *** ROUTINE trc _rad_ini *** 84 78 !! 85 !! ** Purpose : read namelist options 86 !!---------------------------------------------------------------------- 87 INTEGER :: ios ! Local integer output status for namelist read 79 !! ** Purpose : read namelist options 80 !!---------------------------------------------------------------------- 81 INTEGER :: ios ! Local integer output status for namelist read 82 !! 88 83 NAMELIST/namtrc_rad/ ln_trcrad 89 84 !!---------------------------------------------------------------------- 90 91 85 ! 92 86 REWIND( numnat_ref ) ! namtrc_rad in reference namelist 93 87 READ ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 94 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 95 88 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 96 89 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 97 90 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 98 908 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )99 IF(lwm) WRITE 91 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 92 IF(lwm) WRITE( numont, namtrc_rad ) 100 93 101 94 IF(lwp) THEN ! ! Control print 102 95 WRITE(numout,*) 96 WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 97 WRITE(numout,*) '~~~~~~~ ' 103 98 WRITE(numout,*) ' Namelist namtrc_rad : treatment of negative concentrations' 104 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 99 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 100 WRITE(numout,*) 101 IF( ln_trcrad ) THEN ; WRITE(numout,*) ' ===>> ensure the global tracer conservation' 102 ELSE ; WRITE(numout,*) ' ===>> NO strict global tracer conservation' 103 ENDIF 105 104 ENDIF 106 105 ! 107 106 END SUBROUTINE trc_rad_ini 107 108 108 109 109 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) … … 123 123 !! (the total content of concentration is not strictly preserved) 124 124 !!-------------------------------------------------------------------------------- 125 !! Arguments 126 INTEGER, INTENT( in ) :: kt ! ocean time-step index 127 INTEGER , INTENT( in ) :: & 128 jp_sms0, & !: First index of the passive tracer model 129 jp_sms1 !: Last index of the passive tracer model 130 131 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout ) :: & 132 ptrb, ptrn !: before and now traceur concentration 133 134 CHARACTER( len = 1) , INTENT(in), OPTIONAL :: & 135 cpreserv !: flag to preserve content or not 136 137 ! Local declarations 138 INTEGER :: ji, jj, jk, jn ! dummy loop indices 139 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 125 INTEGER , INTENT(in ) :: kt ! ocean time-step index 126 INTEGER , INTENT(in ) :: jp_sms0, jp_sms1 ! First & last index of the passive tracer model 127 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) :: ptrb , ptrn ! before and now traceur concentration 128 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 129 ! 130 INTEGER :: ji, jj, jk, jn ! dummy loop indices 131 LOGICAL :: lldebug = .FALSE. ! local logical 132 REAL(wp):: ztrcorb, ztrmasb, zs2rdt ! temporary scalars 133 REAL(wp):: zcoef , ztrcorn, ztrmasn ! - - 141 134 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 142 REAL(wp) :: zs2rdt 143 LOGICAL :: lldebug = .FALSE. 144 !!---------------------------------------------------------------------- 145 146 147 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 148 149 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 150 135 !!---------------------------------------------------------------------- 136 ! 137 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 138 ! 139 IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==! 140 ! 151 141 DO jn = jp_sms0, jp_sms1 152 ! ! ===========153 ztrcorb = 0. e0 ; ztrmasb = 0.e0154 ztrcorn = 0. e0 ; ztrmasn = 0.e0155 142 ! 143 ztrcorb = 0._wp ; ztrmasb = 0._wp 144 ztrcorn = 0._wp ; ztrmasn = 0._wp 145 ! 156 146 IF( l_trdtrc ) THEN 157 147 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation … … 161 151 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 162 152 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 163 153 ! 164 154 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 165 155 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 166 156 ! 167 157 IF( ztrcorb /= 0 ) THEN 168 158 zcoef = 1. + ztrcorb / ztrmasb … … 172 162 END DO 173 163 ENDIF 174 164 ! 175 165 IF( ztrcorn /= 0 ) THEN 176 166 zcoef = 1. + ztrcorn / ztrmasn … … 190 180 ! 191 181 ENDIF 192 182 ! 193 183 END DO 194 184 ! 195 ! 196 ELSE ! total CFC content is not strictly preserved 197 185 ELSE !== total CFC content is NOT strictly preserved ==! 186 ! 198 187 DO jn = jp_sms0, jp_sms1 199 200 IF( l_trdtrc ) THEN201 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation202 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation203 ENDIF204 188 ! 189 IF( l_trdtrc ) THEN 190 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 191 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 192 ENDIF 193 ! 205 194 DO jk = 1, jpkm1 206 195 DO jj = 1, jpj … … 211 200 END DO 212 201 END DO 213 202 ! 214 203 IF( l_trdtrc ) THEN 215 204 ! … … 222 211 ENDIF 223 212 ! 224 END DO225 213 END DO 214 ! 226 215 ENDIF 227 216 ! 228 217 IF( l_trdtrc ) DEALLOCATE( ztrtrdb, ztrtrdn ) 229 218 ! 230 219 END SUBROUTINE trc_rad_sms 220 231 221 #else 232 222 !!---------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r9124 r9169 60 60 !! - allocates passive tracer BC data structure 61 61 !!---------------------------------------------------------------------- 62 INTEGER,INTENT(IN) :: ntrc ! number of tracers 62 INTEGER,INTENT(in) :: ntrc ! number of tracers 63 ! 63 64 INTEGER :: jl, jn , ib, ibd, ii, ij, ik ! dummy loop indices 64 65 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers … … 68 69 ! 69 70 CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 70 71 71 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read 72 72 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc ! open … … 83 83 ! 84 84 IF( lwp ) THEN 85 WRITE(numout,*) ' '85 WRITE(numout,*) 86 86 WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 87 87 WRITE(numout,*) '~~~~~~~~~~~ ' 88 88 ENDIF 89 89 ! Initialisation and local array allocation 90 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ;ierr3 = 090 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 91 91 ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 92 92 IF( ierr0 > 0 ) THEN … … 99 99 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' ) ; RETURN 100 100 ENDIF 101 nb_trcobc = 0101 nb_trcobc = 0 102 102 n_trc_indobc(:) = 0 103 103 ! … … 106 106 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' ) ; RETURN 107 107 ENDIF 108 nb_trcsbc = 0108 nb_trcsbc = 0 109 109 n_trc_indsbc(:) = 0 110 110 ! … … 113 113 CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' ) ; RETURN 114 114 ENDIF 115 nb_trccbc = 0115 nb_trccbc = 0 116 116 n_trc_indcbc(:) = 0 117 117 ! … … 119 119 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 120 120 READ ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 121 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 122 121 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 123 122 REWIND( numnat_cfg ) ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 124 123 READ ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 125 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )124 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 126 125 IF(lwm) WRITE ( numont, namtrc_bc ) 127 126 … … 129 128 REWIND( numnat_ref ) ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 130 129 READ ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 131 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp )130 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 132 131 133 132 REWIND( numnat_cfg ) ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 134 133 READ ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 135 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp )134 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 136 135 IF(lwm) WRITE ( numont, namtrc_bdy ) 137 136 … … 140 139 DO ib = 1, nb_bdy 141 140 ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 142 IF ( ln_trc_obc(jn) ) THEN 143 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 144 ELSE 145 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 141 IF ( ln_trc_obc(jn) ) THEN ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc (ib) ) 142 ELSE ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 146 143 ENDIF 147 144 ! set damping use in BDY data structure 148 145 trcdta_bdy(jn,ib)%dmp = .false. 149 IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) )trcdta_bdy(jn,ib)%dmp = .true.150 IF(nn_trcdmp_bdy(ib) .EQ. 2 )trcdta_bdy(jn,ib)%dmp = .true.151 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE.0 ) &152 & CALL ctl_stop( ' Use FRS OR relaxation' )153 IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)&154 & CALL ctl_stop( ' Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )155 END DO156 END DO146 IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 147 IF(nn_trcdmp_bdy(ib) == 2 ) trcdta_bdy(jn,ib)%dmp = .true. 148 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 ) & 149 & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 150 IF( .NOT.( 0 < nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) & 151 & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 152 END DO 153 END DO 157 154 ELSE 158 155 ! Force all tracers OBC to false if bdy not used … … 163 160 DO jn = 1, ntrc 164 161 IF( ln_trc_obc(jn) ) THEN 165 nb_trcobc = nb_trcobc + 1 ;n_trc_indobc(jn) = nb_trcobc162 nb_trcobc = nb_trcobc + 1 ; n_trc_indobc(jn) = nb_trcobc 166 163 ENDIF 167 164 IF( ln_trc_sbc(jn) ) THEN 168 nb_trcsbc = nb_trcsbc + 1 ;n_trc_indsbc(jn) = nb_trcsbc165 nb_trcsbc = nb_trcsbc + 1 ; n_trc_indsbc(jn) = nb_trcsbc 169 166 ENDIF 170 167 IF( ln_trc_cbc(jn) ) THEN 171 nb_trccbc = nb_trccbc + 1 ;n_trc_indcbc(jn) = nb_trccbc172 ENDIF 173 END DO168 nb_trccbc = nb_trccbc + 1 ; n_trc_indcbc(jn) = nb_trccbc 169 ENDIF 170 END DO 174 171 175 172 ! Print summmary of Boundary Conditions 176 173 IF( lwp ) THEN 177 WRITE(numout,*) ' '174 WRITE(numout,*) 178 175 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 179 176 IF ( nb_trcsbc > 0 ) THEN … … 181 178 DO jn = 1, ntrc 182 179 IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 183 END DO180 END DO 184 181 ENDIF 185 182 WRITE(numout,'(2a)') ' SURFACE BC data repository : ', TRIM(cn_dir_sbc) 186 187 WRITE(numout,*) ' '183 ! 184 WRITE(numout,*) 188 185 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 189 186 IF( nb_trccbc > 0 ) THEN … … 191 188 DO jn = 1, ntrc 192 189 IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 193 END DO190 END DO 194 191 ENDIF 195 192 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 196 IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE.193 IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE. 197 194 IF( ln_rnf_ctl ) WRITE(numout,'(a)') & 198 195 & ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 199 WRITE(numout,*) ' '196 WRITE(numout,*) 200 197 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc 201 198 … … 207 204 IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, 'Set data to IC and use default condition' , & 208 205 & (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 209 END DO206 END DO 210 207 WRITE(numout,*) ' ' 211 208 DO ib = 1, nb_bdy 212 IF(nn_trcdmp_bdy(ib) .EQ.0) WRITE(numout,9003) ' Boundary ', ib, &213 214 IF(nn_trcdmp_bdy(ib) .EQ.1) WRITE(numout,9003) ' Boundary ', ib, &215 216 IF(nn_trcdmp_bdy(ib) .EQ.2) WRITE(numout,9003) ' Boundary ', ib, &217 218 IF(nn_trcdmp_bdy(ib) .GT.0) THEN209 IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) ' Boundary ', ib, & 210 & ' -> NO damping of tracers' 211 IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) ' Boundary ', ib, & 212 & ' -> damping ONLY for tracers with external data provided' 213 IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) ' Boundary ', ib, & 214 & ' -> damping of ALL tracers' 215 IF(nn_trcdmp_bdy(ib) > 0) THEN 219 216 WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : ' 220 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days'217 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days' 221 218 WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 222 223 END DO224 ENDIF 225 219 ENDIF 220 END DO 221 ENDIF 222 ! 226 223 WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc) 227 224 ENDIF … … 229 226 9002 FORMAT(2x,i5, 3x, a41, 3x, 10a13) 230 227 9003 FORMAT(a, i5, a) 231 228 ! 232 229 ! 233 230 ! OPEN Lateral boundary conditions … … 237 234 CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' ) ; RETURN 238 235 ENDIF 239 236 ! 240 237 igrd = 1 ! Everything is at T-points here 241 238 ! 242 239 DO jn = 1, ntrc 243 240 DO ib = 1, nb_bdy 244 241 ! 245 242 nblen = idx_bdy(ib)%nblen(igrd) 246 247 IF ( ln_trc_obc(jn) ) THEN 248 ! Initialise from external data 243 ! 244 IF( ln_trc_obc(jn) ) THEN !* Initialise from external data *! 249 245 jl = n_trc_indobc(jn) 250 246 slf_i(jl) = sn_trcobc(jn) 251 247 rf_trofac(jl) = rn_trofac(jn) 252 ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 )253 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 )248 ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 ) 249 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 254 250 IF( ierr2 + ierr3 > 0 ) THEN 255 251 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' ) ; RETURN … … 260 256 nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 261 257 nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 262 ELSE263 ! Initialise obc arrays from initial conditions258 ! 259 ELSE !* Initialise obc arrays from initial conditions *! 264 260 ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 265 261 DO ibd = 1, nblen … … 272 268 trcdta_bdy(jn,ib)%rn_fac = 1._wp 273 269 ENDIF 274 END DO275 END DO276 270 END DO 271 END DO 272 ! 277 273 CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 278 274 ENDIF … … 297 293 ENDIF 298 294 ! 299 END DO295 END DO 300 296 ! ! fill sf_trcsbc with slf_i and control print 301 297 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) … … 322 318 ENDIF 323 319 ! 324 END DO320 END DO 325 321 ! ! fill sf_trccbc with slf_i and control print 326 322 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) … … 341 337 !! ** Method : 1) Read BC inputs and update data structures using fldread 342 338 !! 2) Apply Boundary Conditions to tracers 343 !!344 339 !!---------------------------------------------------------------------- 345 340 USE fldread 346 341 !! 347 INTEGER, INTENT( in ) :: kt! ocean time-step index348 INTEGER, INTENT( in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)342 INTEGER, INTENT(in) :: kt ! ocean time-step index 343 INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 349 344 !! 350 345 INTEGER :: ji, jj, jk, jn, jl ! Loop index … … 357 352 WRITE(numout,*) 358 353 WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 359 WRITE(numout,*) '~~~~~~~ ~~~~'354 WRITE(numout,*) '~~~~~~~ ' 360 355 ENDIF 361 356 362 357 ! 1. Update Boundary conditions data 363 IF 364 358 IF( PRESENT(jit) ) THEN 359 ! 365 360 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 366 361 IF( nb_trcobc > 0 ) THEN 367 362 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 368 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1)369 ENDIF 370 363 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 364 ENDIF 365 ! 371 366 ! SURFACE boundary conditions 372 367 IF( nb_trcsbc > 0 ) THEN 373 368 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 374 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)375 ENDIF 376 369 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 370 ENDIF 371 ! 377 372 ! COASTAL boundary conditions 378 373 IF( nb_trccbc > 0 ) THEN 379 374 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 380 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)381 ENDIF 382 375 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 376 ENDIF 377 ! 383 378 ELSE 384 379 ! 385 380 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 386 381 IF( nb_trcobc > 0 ) THEN 387 382 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 388 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1)389 ENDIF 390 383 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 384 ENDIF 385 ! 391 386 ! SURFACE boundary conditions 392 387 IF( nb_trcsbc > 0 ) THEN 393 388 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 394 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc)395 ENDIF 396 389 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc ) 390 ENDIF 391 ! 397 392 ! COASTAL boundary conditions 398 393 IF( nb_trccbc > 0 ) THEN 399 394 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 400 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc)401 ENDIF 402 395 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc ) 396 ENDIF 397 ! 403 398 ENDIF 404 399 … … 408 403 ! 409 404 ! Remove river dilution for tracers with absent river load 410 IF ( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN405 IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 411 406 DO jj = 2, jpj 412 407 DO ji = fs_2, fs_jpim1 … … 414 409 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 415 410 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (trn(ji,jj,jk,jn) * zrnf) 416 END DO417 END DO418 END DO419 ENDIF 420 411 END DO 412 END DO 413 END DO 414 ENDIF 415 ! 421 416 ! OPEN boundary conditions: trcbdy is called in trcnxt ! 422 417 ! 423 418 ! SURFACE boundary conditions 424 IF (ln_trc_sbc(jn)) THEN419 IF( ln_trc_sbc(jn) ) THEN 425 420 jl = n_trc_indsbc(jn) 426 421 DO jj = 2, jpj … … 430 425 END DO 431 426 END DO 432 END 433 427 ENDIF 428 ! 434 429 ! COASTAL boundary conditions 435 IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN430 IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 436 431 jl = n_trc_indcbc(jn) 437 432 DO jj = 2, jpj … … 440 435 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 441 436 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 442 END DO437 END DO 443 438 END DO 444 439 END DO 445 END 440 ENDIF 446 441 ! ! =========== 447 442 END DO ! tracer loop … … 460 455 WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 461 456 END SUBROUTINE trc_bc_ini 462 463 457 SUBROUTINE trc_bc( kt ) ! Empty routine 464 458 WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r9124 r9169 55 55 !! - allocates passive tracer data structure 56 56 !!---------------------------------------------------------------------- 57 ! 58 INTEGER,INTENT(IN) :: ntrc ! number of tracers 59 INTEGER :: jl, jn ! dummy loop indices 60 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 61 INTEGER :: ios ! Local integer output status for namelist read 62 CHARACTER(len=100) :: clndta, clntrc 63 REAL(wp) :: zfact 64 ! 65 CHARACTER(len=100) :: cn_dir 57 INTEGER,INTENT(in) :: ntrc ! number of tracers 58 ! 59 INTEGER :: jl, jn ! dummy loop indices 60 INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers 61 REAL(wp) :: zfact 62 CHARACTER(len=100) :: clndta, clntrc 63 ! 64 CHARACTER(len=100) :: cn_dir 66 65 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 67 66 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta … … 72 71 ! 73 72 IF( lwp ) THEN 74 WRITE(numout,*) ' '75 WRITE(numout,*) ' 76 WRITE(numout,*) ' 73 WRITE(numout,*) 74 WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)' 75 WRITE(numout,*) '~~~~~~~~~~~ ' 77 76 ENDIF 78 77 ! … … 91 90 n_trc_index(jn) = nb_trcdta 92 91 ENDIF 93 END DO92 END DO 94 93 ! 95 94 ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking 96 95 IF(lwp) THEN 97 WRITE(numout,*) ' ' 98 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 99 WRITE(numout,*) ' ' 96 WRITE(numout,*) 97 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 100 98 ENDIF 101 99 ! 102 100 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 103 101 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 104 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 105 102 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 106 103 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 107 104 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 108 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp )105 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 109 106 IF(lwm) WRITE ( numont, namtrc_dta ) 110 107 … … 121 118 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 122 119 ENDIF 123 WRITE(numout,*) ' '124 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', &120 WRITE(numout,*) 121 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 125 122 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 126 123 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcice.F90
r9124 r9169 10 10 !! 'key_top' TOP models 11 11 !!---------------------------------------------------------------------- 12 !! trc_ice : Call the appropriate sea ice tracer subroutine12 !! trc_ice : Call the appropriate sea ice tracer subroutine 13 13 !!---------------------------------------------------------------------- 14 USE oce_trc 15 USE trc 16 USE trcice_cfc 17 USE trcice_pisces 18 USE trcice_c14 19 USE trcice_age ! aGEinitialisation20 USE trcice_my_trc 14 USE oce_trc ! shared variables between ocean and passive tracers 15 USE trc ! passive tracers common variables 16 USE trcice_cfc ! CFC initialisation 17 USE trcice_pisces ! PISCES initialisation 18 USE trcice_c14 ! C14 bomb initialisation 19 USE trcice_age ! AGE initialisation 20 USE trcice_my_trc ! MY_TRC initialisation 21 21 22 22 IMPLICIT NONE … … 39 39 !! 40 40 !! ** Method : - 41 !!42 41 !!--------------------------------------------------------------------- 43 42 ! … … 71 70 !! 72 71 !! ** Method : - 73 !!74 72 !!--------------------------------------------------------------------- 75 73 INTEGER :: jn ! dummy loop indices 76 74 INTEGER :: ios, ierr ! Local integer output status for namelist read 77 75 ! 78 TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer76 TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 79 77 !! 80 78 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer … … 89 87 REWIND( numnat_ref ) ! Namelist namtrc_ice in reference namelist : Passive tracer input data 90 88 READ ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 91 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 92 89 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 93 90 REWIND( numnat_cfg ) ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 94 91 READ ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 95 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )92 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 96 93 97 94 IF( lwp ) THEN 98 95 WRITE(numout,*) ' ' 99 WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr100 WRITE(numout,*) ' '96 WRITE(numout,*) ' Namelist : namtrc_ice' 97 WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 101 98 ENDIF 102 99 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r9124 r9169 56 56 IF(lwp) WRITE(numout,*) 57 57 IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 58 IF(lwp) WRITE(numout,*) '~~~~~~~ '58 IF(lwp) WRITE(numout,*) '~~~~~~~~' 59 59 ! 60 60 CALL trc_ini_ctl ! control … … 109 109 CHARACTER (len=25) :: charout 110 110 !!---------------------------------------------------------------------- 111 ! ! masked grid volume 111 ! 112 IF(lwp) WRITE(numout,*) 113 IF(lwp) WRITE(numout,*) 'trc_ini_inv : initial passive tracers inventories' 114 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 115 ! 116 ! ! masked grid volume 112 117 DO jk = 1, jpk 113 118 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 114 119 END DO 115 ! 120 ! ! total volume of the ocean 116 121 areatot = glob_sum( cvol(:,:,:) ) 117 122 ! 118 trai(:) = 0._wp 123 trai(:) = 0._wp ! initial content of all tracers 119 124 DO jn = 1, jptra 120 125 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) … … 123 128 IF(lwp) THEN ! control print 124 129 WRITE(numout,*) 125 WRITE(numout,*) ' ***Total number of passive tracer jptra = ', jptra126 WRITE(numout,*) ' ***Total volume of ocean = ', areatot127 WRITE(numout,*) ' ***Total inital content of all tracers '130 WRITE(numout,*) ' ==>>> Total number of passive tracer jptra = ', jptra 131 WRITE(numout,*) ' Total volume of ocean = ', areatot 132 WRITE(numout,*) ' Total inital content of all tracers ' 128 133 WRITE(numout,*) 129 134 DO jn = 1, jptra … … 139 144 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 140 145 ENDIF 141 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)146 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 142 147 ! 143 148 END SUBROUTINE trc_ini_inv … … 177 182 IF(lwp) THEN ! control print 178 183 WRITE(numout,*) 179 WRITE(numout,*) ' trc_init: Summary for selected passive tracers'180 WRITE(numout,*) ' ~~~~~~~~~~~~~~'181 WRITE(numout,*) ' ID NAME INI SBC CBC OBC'184 WRITE(numout,*) 'trc_init_sms : Summary for selected passive tracers' 185 WRITE(numout,*) '~~~~~~~~~~~~' 186 WRITE(numout,*) ' ID NAME INI SBC CBC OBC' 182 187 DO jn = 1, jptra 183 188 WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn) 184 189 END DO 185 190 ENDIF 186 9001 FORMAT( 1x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2)191 9001 FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 187 192 ! 188 193 END SUBROUTINE trc_ini_sms 194 189 195 190 196 SUBROUTINE trc_ini_trp … … 223 229 !!---------------------------------------------------------------------- 224 230 ! 225 226 231 IF( ln_trcdta ) CALL trc_dta_ini( jptra ) ! set initial tracers values 227 232 ! 228 233 IF( ln_my_trc ) CALL trc_bc_ini ( jptra ) ! set tracers Boundary Conditions 229 230 234 ! 235 ! 231 236 IF( ln_rsttr ) THEN ! restart from a file 232 237 ! … … 244 249 ! deallocate data structure if data are not used for damping 245 250 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 246 IF(lwp) WRITE(numout,*) 'trc_ dta: deallocate data arrays as they are only used to initialize the run'251 IF(lwp) WRITE(numout,*) 'trc_ini_state: deallocate data arrays as they are only used to initialize the run' 247 252 DEALLOCATE( sf_trcdta(jl)%fnow ) 248 253 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) … … 257 262 ! 258 263 ENDIF 259 264 ! 260 265 tra(:,:,:,:) = 0._wp 261 266 ! ! Partial top/bottom cell: GRADh(trn) … … 275 280 #endif 276 281 ! 277 INTEGER :: ierr282 INTEGER :: ierr ! local integer 278 283 !!---------------------------------------------------------------------- 279 284 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r7646 r9169 18 18 !! trc_nam : Read and print options for the passive tracer run (namelist) 19 19 !!---------------------------------------------------------------------- 20 USE oce_trc 21 USE trc 22 USE trd_oce 23 USE trdtrc_oce 24 USE iom 20 USE oce_trc ! shared variables between ocean and passive tracers 21 USE trc ! passive tracers common variables 22 USE trd_oce ! 23 USE trdtrc_oce ! 24 USE iom ! I/O manager 25 25 26 26 IMPLICIT NONE 27 27 PRIVATE 28 28 29 PUBLIC trc_nam_run ! called in trcini30 PUBLIC trc_nam ! called in trcini31 32 TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC :: sn_tracer ! type of tracer for saving if not key_iomput29 PUBLIC trc_nam_run ! called in trcini 30 PUBLIC trc_nam ! called in trcini 31 32 TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC :: sn_tracer !: type of tracer for saving if not key_iomput 33 33 34 34 !!---------------------------------------------------------------------- … … 49 49 !! ( (PISCES, CFC, MY_TRC ) 50 50 !!--------------------------------------------------------------------- 51 INTEGER :: jn ! dummy loop indice 51 INTEGER :: jn ! dummy loop indice 52 !!--------------------------------------------------------------------- 52 53 ! 53 54 IF( .NOT.l_offline ) CALL trc_nam_run ! Parameters of the run 54 55 ! 55 CALL trc_nam_trc ! passive tracer informations56 CALL trc_nam_trc ! passive tracer informations 56 57 ! 57 IF( ln_rsttr ) ln_trcdta 58 ! 59 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE.! damping : need to have clim data60 ! 61 58 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 59 ! 60 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 61 ! 62 ! 62 63 IF(lwp) THEN ! control print 63 64 IF( ln_rsttr ) THEN 64 65 WRITE(numout,*) 65 WRITE(numout,*) ' Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 66 WRITE(numout,*) 66 WRITE(numout,*) ' ==>>> Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 67 67 ENDIF 68 68 IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN 69 69 WRITE(numout,*) 70 WRITE(numout,*) ' Some of the passive tracers are initialised from climatologies ' 71 WRITE(numout,*) 70 WRITE(numout,*) ' ==>>> Some of the passive tracers are initialised from climatologies ' 72 71 ENDIF 73 72 IF( .NOT.ln_trcdta ) THEN 74 73 WRITE(numout,*) 75 WRITE(numout,*) ' All the passive tracers are initialised with constant values ' 76 WRITE(numout,*) 74 WRITE(numout,*) ' ==>>> All the passive tracers are initialised with constant values ' 77 75 ENDIF 78 76 ENDIF … … 82 80 IF(lwp) THEN ! control print 83 81 WRITE(numout,*) 84 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc 85 WRITE(numout,*) 82 WRITE(numout,*) ' ==>>> Passive Tracer time step rdttrc = nn_dttrc*rdt = ', rdttrc 86 83 ENDIF 87 84 ! … … 98 95 !! 99 96 !!--------------------------------------------------------------------- 97 INTEGER :: ios ! Local integer 98 !! 100 99 NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 101 100 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 102 ! 103 INTEGER :: ios ! Local integer output status for namelist read 104 !!--------------------------------------------------------------------- 105 ! 101 !!--------------------------------------------------------------------- 102 ! 103 IF(lwp) WRITE(numout,*) 106 104 IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 107 IF(lwp) WRITE(numout,*) '~~~~~~~ '108 105 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 106 ! 109 107 CALL ctl_opn( numnat_ref, 'namelist_top_ref' , 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 110 108 CALL ctl_opn( numnat_cfg, 'namelist_top_cfg' , 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 111 109 IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 ) 112 110 ! 113 111 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables 114 112 READ ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901) 115 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 116 113 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 117 114 REWIND( numnat_cfg ) ! Namelist namtrc in configuration namelist : Passive tracer variables 118 115 READ ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 ) 119 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 120 IF(lwm) WRITE ( numont, namtrc_run ) 121 122 ! computes the first time step of tracer model 123 nittrc000 = nit000 + nn_dttrc - 1 116 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 117 IF(lwm) WRITE( numont, namtrc_run ) 118 119 nittrc000 = nit000 + nn_dttrc - 1 ! first time step of tracer model 124 120 125 121 IF(lwp) THEN ! control print 126 WRITE(numout,*) 127 WRITE(numout,*) ' Namelist : namtrc_run' 128 WRITE(numout,*) ' time step freq. for passive tracer nn_dttrc = ', nn_dttrc 129 WRITE(numout,*) ' restart for passive tracer ln_rsttr = ', ln_rsttr 130 WRITE(numout,*) ' control of time step for passive tracer nn_rsttr = ', nn_rsttr 131 WRITE(numout,*) ' first time step for pass. trac. nittrc000 = ', nittrc000 132 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 133 WRITE(numout,*) ' ' 122 WRITE(numout,*) ' Namelist : namtrc_run' 123 WRITE(numout,*) ' time step freq. for passive tracer nn_dttrc = ', nn_dttrc 124 WRITE(numout,*) ' restart for passive tracer ln_rsttr = ', ln_rsttr 125 WRITE(numout,*) ' control of time step for passive tracer nn_rsttr = ', nn_rsttr 126 WRITE(numout,*) ' first time step for pass. trac. nittrc000 = ', nittrc000 127 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 134 128 ENDIF 135 129 ! 136 130 END SUBROUTINE trc_nam_run 137 131 132 138 133 SUBROUTINE trc_nam_trc 139 134 !!--------------------------------------------------------------------- … … 143 138 !! 144 139 !!--------------------------------------------------------------------- 145 INTEGER :: ios, ierr, icfc ! Local integer output status for namelist read140 INTEGER :: ios, ierr, icfc ! Local integer 146 141 !! 147 142 NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & … … 154 149 IF(lwp) WRITE(numout,*) 155 150 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 156 IF(lwp) WRITE(numout,*) '~~~~~~~ '151 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 157 152 158 153 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables 159 154 READ ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901) 160 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 161 155 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 162 156 REWIND( numnat_cfg ) ! Namelist namtrc in configuration namelist : Passive tracer variables 163 157 READ ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 ) 164 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )165 IF(lwm) WRITE 158 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 159 IF(lwm) WRITE( numont, namtrc ) 166 160 167 161 ! Control settings … … 209 203 ! 210 204 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,*) ' ' 205 WRITE(numout,*) ' Namelist : namtrc' 206 WRITE(numout,*) ' Total number of passive tracers jptra = ', jptra 207 WRITE(numout,*) ' Total number of BGC tracers jp_bgc = ', jp_bgc 208 WRITE(numout,*) ' Simulating PISCES model ln_pisces = ', ln_pisces 209 WRITE(numout,*) ' Simulating MY_TRC model ln_my_trc = ', ln_my_trc 210 WRITE(numout,*) ' Simulating water mass age ln_age = ', ln_age 211 WRITE(numout,*) ' Simulating CFC11 passive tracer ln_cfc11 = ', ln_cfc11 212 WRITE(numout,*) ' Simulating CFC12 passive tracer ln_cfc12 = ', ln_cfc12 213 WRITE(numout,*) ' Simulating SF6 passive tracer ln_sf6 = ', ln_sf6 214 WRITE(numout,*) ' Total number of CFCs tracers jp_cfc = ', jp_cfc 215 WRITE(numout,*) ' Simulating C14 passive tracer ln_c14 = ', ln_c14 216 WRITE(numout,*) ' Read inputs data from file (y/n) ln_trcdta = ', ln_trcdta 217 WRITE(numout,*) ' Damping of passive tracer (y/n) ln_trcdmp = ', ln_trcdmp 218 WRITE(numout,*) ' Restoring of tracer on closed seas ln_trcdmp_clo = ', ln_trcdmp_clo 228 219 ENDIF 229 220 ! … … 235 226 ! 236 227 ENDIF 237 228 ! 238 229 END SUBROUTINE trc_nam_trc 230 239 231 240 232 SUBROUTINE trc_nam_trd … … 248 240 !! ( (PISCES, CFC, MY_TRC ) 249 241 !!--------------------------------------------------------------------- 250 251 242 #if defined key_trdmxl_trc || defined key_trdtrc 252 INTEGER :: ios ! Local integer output status for namelist read 253 INTEGER :: ierr 243 INTEGER :: ios, ierr ! Local integer 254 244 !! 255 245 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & … … 257 247 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 258 248 !!--------------------------------------------------------------------- 259 249 ! 260 250 IF(lwp) WRITE(numout,*) 261 251 IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options' 262 IF(lwp) WRITE(numout,*) '~~~~~~~' 263 252 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 264 253 ! 265 254 ALLOCATE( ln_trdtrc(jptra) ) … … 267 256 REWIND( numnat_ref ) ! Namelist namtrc_trd in reference namelist : Passive tracer trends 268 257 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 258 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 271 259 REWIND( numnat_cfg ) ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 272 260 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 261 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 262 IF(lwm) WRITE( numont, namtrc_trd ) 275 263 276 264 IF(lwp) THEN 277 WRITE(numout,*) 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 265 WRITE(numout,*) ' Namelist : namtrc_trd ' 266 WRITE(numout,*) ' frequency of trends diagnostics nn_trd_trc = ', nn_trd_trc 267 WRITE(numout,*) ' control surface type nn_ctls_trc = ', nn_ctls_trc 268 WRITE(numout,*) ' restart for ML diagnostics ln_trdmxl_trc_restart = ', ln_trdmxl_trc_restart 269 WRITE(numout,*) ' instantantaneous or mean trends ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant 270 WRITE(numout,*) ' unit conversion factor rn_ucf_trc = ', rn_ucf_trc 286 271 DO jn = 1, jptra 287 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn272 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 288 273 END DO 289 274 ENDIF … … 303 288 #endif 304 289 305 !!----------------------------------------------------------------------306 !! NEMO/TOP 3.3 , NEMO Consortium (2010)307 !! $Id$308 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)309 290 !!====================================================================== 310 291 END MODULE trcnam
Note: See TracChangeset
for help on using the changeset viewer.