Changeset 9169
- Timestamp:
- 2017-12-26T17:32:56+01:00 (3 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