- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domain.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DOM/domain.F90
r10425 r13463 15 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 17 !! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 17 18 !!---------------------------------------------------------------------- 18 19 … … 30 31 USE trc_oce ! shared ocean & passive tracers variab 31 32 USE phycst ! physical constants 32 USE closea ! closed seas33 33 USE domhgr ! domain: set the horizontal mesh 34 34 USE domzgr ! domain: set the vertical mesh 35 35 USE dommsk ! domain: set the mask system 36 36 USE domwri ! domain: write the meshmask file 37 #if ! defined key_qco 37 38 USE domvvl ! variable volume 39 #else 40 USE domqco ! variable volume 41 #endif 38 42 USE c1d ! 1D configuration 39 43 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) 40 USE wet_dry, ONLY : ll_wd 44 USE wet_dry, ONLY : ll_wd 45 USE closea , ONLY : dom_clo ! closed seas 41 46 ! 42 47 USE in_out_manager ! I/O manager … … 58 63 CONTAINS 59 64 60 SUBROUTINE dom_init( cdstr)65 SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr ) 61 66 !!---------------------------------------------------------------------- 62 67 !! *** ROUTINE dom_init *** … … 73 78 !! - 1D configuration, move Coriolis, u and v at T-point 74 79 !!---------------------------------------------------------------------- 75 INTEGER :: ji, jj, jk, ik ! dummy loop indices 80 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 81 CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables 82 ! 83 INTEGER :: ji, jj, jk, jt ! dummy loop indices 76 84 INTEGER :: iconf = 0 ! local integers 77 85 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 78 CHARACTER (len=*), INTENT(IN) :: cdstr ! model: NEMO or SAS. Determines core restart variables79 86 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 80 87 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 101 108 CASE( 0 ) ; WRITE(numout,*) ' (i.e. closed)' 102 109 CASE( 1 ) ; WRITE(numout,*) ' (i.e. cyclic east-west)' 103 CASE( 2 ) ; WRITE(numout,*) ' (i.e. equatorial symmetric)'110 CASE( 2 ) ; WRITE(numout,*) ' (i.e. cyclic north-south)' 104 111 CASE( 3 ) ; WRITE(numout,*) ' (i.e. north fold with T-point pivot)' 105 112 CASE( 4 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with T-point pivot)' … … 108 115 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)' 109 116 CASE DEFAULT 110 CALL ctl_stop( ' jperio is out of range' )117 CALL ctl_stop( 'dom_init: jperio is out of range' ) 111 118 END SELECT 112 119 WRITE(numout,*) ' Ocean model configuration used:' … … 134 141 ENDIF 135 142 ! 136 CALL dom_hgr ! Horizontal mesh 137 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry 138 CALL dom_msk( ik_top, ik_bot ) ! Masks 139 IF( ln_closea ) CALL dom_clo ! ln_closea=T : closed seas included in the simulation 140 ! Read in masks to define closed seas and lakes 141 ! 142 DO jj = 1, jpj ! depth of the iceshelves 143 DO ji = 1, jpi 144 ik = mikt(ji,jj) 145 risfdep(ji,jj) = gdepw_0(ji,jj,ik) 146 END DO 147 END DO 143 CALL dom_hgr ! Horizontal mesh 144 145 IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes 146 147 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices) 148 149 CALL dom_msk( ik_top, ik_bot ) ! Masks 148 150 ! 149 151 ht_0(:,:) = 0._wp ! Reference ocean thickness 150 152 hu_0(:,:) = 0._wp 151 153 hv_0(:,:) = 0._wp 154 hf_0(:,:) = 0._wp 152 155 DO jk = 1, jpk 153 156 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 154 157 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 155 158 hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 159 hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk) 156 160 END DO 157 161 ! 162 r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp - ssmask (:,:) ) 163 r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) 164 r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 165 r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) ) 166 167 ! 168 #if defined key_qco 169 ! !== initialisation of time varying coordinate ==! Quasi-Euerian coordinate case 170 ! 171 IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa ) 172 ! 173 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 174 ! 175 #else 158 176 ! !== time varying part of coordinate system ==! 159 177 ! 160 178 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 161 !162 ! before ! now ! after !163 gdept _b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points164 gdepw _b = gdepw_0 ; gdepw_n = gdepw_0 ! --- !165 gde3w_n = gde3w_0 ! --- !166 !167 e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors168 e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 !169 e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 !170 e3f_n = e3f_0 ! --- !171 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- !172 e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- !173 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- !174 !175 z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF176 z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:))177 ! 178 ! before ! now ! after !179 ht_n = ht_0 ! ! water column thickness180 hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 !181 hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 !182 r1_h u_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness183 r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 !184 !179 ! 180 DO jt = 1, jpt ! depth of t- and w-grid-points 181 gdept(:,:,:,jt) = gdept_0(:,:,:) 182 gdepw(:,:,:,jt) = gdepw_0(:,:,:) 183 END DO 184 gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t 185 ! 186 DO jt = 1, jpt ! vertical scale factors 187 e3t(:,:,:,jt) = e3t_0(:,:,:) 188 e3u(:,:,:,jt) = e3u_0(:,:,:) 189 e3v(:,:,:,jt) = e3v_0(:,:,:) 190 e3w(:,:,:,jt) = e3w_0(:,:,:) 191 e3uw(:,:,:,jt) = e3uw_0(:,:,:) 192 e3vw(:,:,:,jt) = e3vw_0(:,:,:) 193 END DO 194 e3f(:,:,:) = e3f_0(:,:,:) 195 ! 196 DO jt = 1, jpt ! water column thickness and its inverse 197 hu(:,:,jt) = hu_0(:,:) 198 hv(:,:,jt) = hv_0(:,:) 199 r1_hu(:,:,jt) = r1_hu_0(:,:) 200 r1_hv(:,:,jt) = r1_hv_0(:,:) 201 END DO 202 ht(:,:) = ht_0(:,:) 185 203 ! 186 204 ELSE != time varying : initialize before/now/after variables 187 205 ! 188 IF( .NOT.l_offline ) CALL dom_vvl_init 189 ! 190 ENDIF 191 ! 206 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 207 ! 208 ENDIF 209 #endif 210 211 ! 212 192 213 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 193 214 ! 194 IF( ln_meshmask .AND. .NOT.ln_iscpl ) CALL dom_wri ! Create a domain file 195 IF( ln_meshmask .AND. ln_iscpl .AND. .NOT.ln_rstart ) CALL dom_wri ! Create a domain file 196 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 197 ! 198 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file 215 216 #if defined key_agrif 217 IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 218 #endif 219 IF( ln_meshmask ) CALL dom_wri ! Create a domain file 220 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 221 ! 222 IF( ln_write_cfg ) CALL cfg_write ! create the configuration file 199 223 ! 200 224 IF(lwp) THEN … … 216 240 !! ** Method : 217 241 !! 218 !! ** Action : - mig , mjg : local domain indices ==> global domain indices 242 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices 243 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 219 244 !! - mi0 , mi1 : global domain indices ==> local domain indices 220 !! - mj0 ,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)245 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 221 246 !!---------------------------------------------------------------------- 222 247 INTEGER :: ji, jj ! dummy loop argument 223 248 !!---------------------------------------------------------------------- 224 249 ! 225 DO ji = 1, jpi ! local domain indices ==> global domain indices 250 DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos 226 251 mig(ji) = ji + nimpp - 1 227 252 END DO … … 229 254 mjg(jj) = jj + njmpp - 1 230 255 END DO 231 ! ! global domain indices ==> local domain indices 256 ! ! local domain indices ==> global domain indices, excluding halos 257 ! 258 mig0(:) = mig(:) - nn_hls 259 mjg0(:) = mjg(:) - nn_hls 260 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 261 ! we must define mig0 and mjg0 as bellow. 262 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 263 mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 264 mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 265 ! 266 ! ! global domain, including halos, indices ==> local domain indices 232 267 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 233 268 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. … … 247 282 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 248 283 WRITE(numout,*) 249 WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done' 250 IF( nn_print >= 1 ) THEN 251 WRITE(numout,*) 252 WRITE(numout,*) ' conversion local ==> global i-index domain (mig)' 253 WRITE(numout,25) (mig(ji),ji = 1,jpi) 254 WRITE(numout,*) 255 WRITE(numout,*) ' conversion global ==> local i-index domain' 256 WRITE(numout,*) ' starting index (mi0)' 257 WRITE(numout,25) (mi0(ji),ji = 1,jpiglo) 258 WRITE(numout,*) ' ending index (mi1)' 259 WRITE(numout,25) (mi1(ji),ji = 1,jpiglo) 260 WRITE(numout,*) 261 WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)' 262 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 263 WRITE(numout,*) 264 WRITE(numout,*) ' conversion global ==> local j-index domain' 265 WRITE(numout,*) ' starting index (mj0)' 266 WRITE(numout,25) (mj0(jj),jj = 1,jpjglo) 267 WRITE(numout,*) ' ending index (mj1)' 268 WRITE(numout,25) (mj1(jj),jj = 1,jpjglo) 269 ENDIF 270 ENDIF 271 25 FORMAT( 100(10x,19i4,/) ) 284 ENDIF 272 285 ! 273 286 END SUBROUTINE dom_glo … … 291 304 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & 292 305 & nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , & 293 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler ,&294 & ln_cfmeta, ln_ iscpl, ln_xios_read, nn_wxios295 NAMELIST/namdom/ ln_linssh, rn_ isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask306 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, ln_1st_euler , & 307 & ln_cfmeta, ln_xios_read, nn_wxios 308 NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 296 309 #if defined key_netcdf4 297 310 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 306 319 ! 307 320 ! 308 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run309 321 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 310 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 311 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 322 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist' ) 312 323 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 313 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' , lwp)324 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 314 325 IF(lwm) WRITE ( numond, namrun ) 326 327 #if defined key_agrif 328 IF( .NOT. Agrif_Root() ) THEN 329 nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 330 nn_itend = Agrif_Parent(nn_itend) *Agrif_IRhot() 331 ENDIF 332 #endif 315 333 ! 316 334 IF(lwp) THEN ! control print … … 323 341 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 324 342 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 325 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler343 WRITE(numout,*) ' start with forward time step ln_1st_euler = ', ln_1st_euler 326 344 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 327 345 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 … … 336 354 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 337 355 ENDIF 356 #if ! defined key_iomput 338 357 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 358 #endif 339 359 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 340 360 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta 341 361 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 342 362 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 343 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl344 363 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 345 364 WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read … … 358 377 nleapy = nn_leapy 359 378 ninist = nn_istate 360 nstock = nn_stock 361 nstocklist = nn_stocklist 362 nwrite = nn_write 363 neuler = nn_euler 364 IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 379 l_1st_euler = ln_1st_euler 380 IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 365 381 IF(lwp) WRITE(numout,*) 366 382 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 367 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0'368 neuler = 0383 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 384 l_1st_euler = .true. 369 385 ENDIF 370 386 ! ! control of output frequency 371 IF( nstock == 0 .OR. nstock > nitend ) THEN 372 WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 387 IF( .NOT. ln_rst_list ) THEN ! we use nn_stock 388 IF( nn_stock == -1 ) CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' ) 389 IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN 390 WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend 391 CALL ctl_warn( ctmp1 ) 392 nn_stock = nitend 393 ENDIF 394 ENDIF 395 #if ! defined key_iomput 396 IF( nn_write == -1 ) CALL ctl_warn( 'nn_write = -1 --> no output files will be done' ) 397 IF ( nn_write == 0 ) THEN 398 WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend 373 399 CALL ctl_warn( ctmp1 ) 374 nstock = nitend 375 ENDIF 376 IF ( nwrite == 0 ) THEN 377 WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 378 CALL ctl_warn( ctmp1 ) 379 nwrite = nitend 380 ENDIF 381 400 nn_write = nitend 401 ENDIF 402 #endif 403 404 IF( Agrif_Root() ) THEN 405 IF(lwp) WRITE(numout,*) 406 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 407 CASE ( 1 ) 408 CALL ioconf_calendar('gregorian') 409 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 410 CASE ( 0 ) 411 CALL ioconf_calendar('noleap') 412 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 413 CASE ( 30 ) 414 CALL ioconf_calendar('360d') 415 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 416 END SELECT 417 ENDIF 418 419 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 420 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' ) 421 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 422 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 423 IF(lwm) WRITE( numond, namdom ) 424 ! 382 425 #if defined key_agrif 383 IF( Agrif_Root() ) THEN 384 #endif 385 IF(lwp) WRITE(numout,*) 386 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 387 CASE ( 1 ) 388 CALL ioconf_calendar('gregorian') 389 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 390 CASE ( 0 ) 391 CALL ioconf_calendar('noleap') 392 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 393 CASE ( 30 ) 394 CALL ioconf_calendar('360d') 395 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 396 END SELECT 397 #if defined key_agrif 398 ENDIF 399 #endif 400 401 REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 402 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 403 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 404 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 405 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 406 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 407 IF(lwm) WRITE( numond, namdom ) 426 IF( .NOT. Agrif_Root() ) THEN 427 rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 428 ENDIF 429 #endif 408 430 ! 409 431 IF(lwp) THEN … … 412 434 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 413 435 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 414 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]' 415 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 436 WRITE(numout,*) ' ocean time step rn_Dt = ', rn_Dt 416 437 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 417 438 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 418 439 ENDIF 419 440 ! 420 ! ! conversion DOCTOR names into model names (this should disappear soon)421 atfp = rn_atfp422 r dt = rn_rdt441 !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 442 rDt = 2._wp * rn_Dt 443 r1_Dt = 1._wp / rDt 423 444 424 445 IF( TRIM(Agrif_CFixed()) == '0' ) THEN … … 431 452 #if defined key_netcdf4 432 453 ! ! NetCDF 4 case ("key_netcdf4" defined) 433 REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF434 454 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 435 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 436 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 455 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) 437 456 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 438 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' , lwp)457 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' ) 439 458 IF(lwm) WRITE( numond, namnc4 ) 440 459 … … 469 488 !! ** Method : compute and print extrema of masked scale factors 470 489 !!---------------------------------------------------------------------- 471 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2 472 INTEGER, DIMENSION(2) :: iloc ! 473 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 474 !!---------------------------------------------------------------------- 475 ! 476 IF(lk_mpp) THEN 477 CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 478 CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 479 CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 480 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 481 ELSE 482 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 483 ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 484 ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 485 ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 486 ! 487 iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 488 imi1(1) = iloc(1) + nimpp - 1 489 imi1(2) = iloc(2) + njmpp - 1 490 iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 491 imi2(1) = iloc(1) + nimpp - 1 492 imi2(2) = iloc(2) + njmpp - 1 493 iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 494 ima1(1) = iloc(1) + nimpp - 1 495 ima1(2) = iloc(2) + njmpp - 1 496 iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 497 ima2(1) = iloc(1) + nimpp - 1 498 ima2(2) = iloc(2) + njmpp - 1 499 ENDIF 490 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 491 INTEGER, DIMENSION(2) :: imil, imip, imi1, imi2, imal, imap, ima1, ima2 492 REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 493 !!---------------------------------------------------------------------- 494 ! 495 llmsk = tmask_h(:,:) == 1._wp 496 ! 497 CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 498 CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 499 CALL mpp_minloc( 'domain', e1t(:,:), llmsk, ze1min, imi1 ) 500 CALL mpp_minloc( 'domain', e2t(:,:), llmsk, ze2min, imi2 ) 501 CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 502 CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 503 CALL mpp_maxloc( 'domain', e1t(:,:), llmsk, ze1max, ima1 ) 504 CALL mpp_maxloc( 'domain', e2t(:,:), llmsk, ze2max, ima2 ) 505 ! 500 506 IF(lwp) THEN 501 507 WRITE(numout,*) 502 508 WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 503 509 WRITE(numout,*) '~~~~~~~' 504 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 505 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 506 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 507 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 510 WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 511 WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 512 WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 513 WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 514 WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 515 WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 516 WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 517 WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 508 518 ENDIF 509 519 ! … … 511 521 512 522 513 SUBROUTINE domain_cfg( ldtxt,cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )523 SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 514 524 !!---------------------------------------------------------------------- 515 525 !! *** ROUTINE dom_nam *** … … 519 529 !! ** Method : read the cn_domcfg NetCDF file 520 530 !!---------------------------------------------------------------------- 521 CHARACTER(len=*), DIMENSION(:), INTENT(out) :: ldtxt ! stored print information522 531 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 523 532 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution … … 525 534 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 526 535 ! 527 INTEGER :: inum , ii! local integer536 INTEGER :: inum ! local integer 528 537 REAL(wp) :: zorca_res ! local scalars 529 REAL(wp) :: ziglo, zjglo, zkglo, zperio ! - - 530 !!---------------------------------------------------------------------- 531 ! 532 ii = 1 533 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 534 WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' ; ii = ii+1 535 WRITE(ldtxt(ii),*) '~~~~~~~~~~ ' ; ii = ii+1 538 REAL(wp) :: zperio ! - - 539 INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions 540 !!---------------------------------------------------------------------- 541 ! 542 IF(lwp) THEN 543 WRITE(numout,*) ' ' 544 WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' 545 WRITE(numout,*) '~~~~~~~~~~ ' 546 ENDIF 536 547 ! 537 548 CALL iom_open( cn_domcfg, inum ) … … 544 555 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res ) 545 556 ! 546 WRITE(ldtxt(ii),*) ' .' ; ii = ii+1 547 WRITE(ldtxt(ii),*) ' ==>>> ORCA configuration ' ; ii = ii+1 548 WRITE(ldtxt(ii),*) ' .' ; ii = ii+1 557 IF(lwp) THEN 558 WRITE(numout,*) ' .' 559 WRITE(numout,*) ' ==>>> ORCA configuration ' 560 WRITE(numout,*) ' .' 561 ENDIF 549 562 ! 550 563 ELSE !- cd_cfg & k_cfg are not used … … 559 572 ! 560 573 ENDIF 561 ! 562 CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = NINT( ziglo ) 563 CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = NINT( zjglo ) 564 CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = NINT( zkglo ) 574 ! 575 idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo 576 kpi = idimsz(1) 577 kpj = idimsz(2) 578 kpk = idimsz(3) 565 579 CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio ) 566 580 CALL iom_close( inum ) 567 581 ! 568 WRITE(ldtxt(ii),*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg ; ii = ii+1 569 WRITE(ldtxt(ii),*) ' jpiglo = ', kpi ; ii = ii+1 570 WRITE(ldtxt(ii),*) ' jpjglo = ', kpj ; ii = ii+1 571 WRITE(ldtxt(ii),*) ' jpkglo = ', kpk ; ii = ii+1 572 WRITE(ldtxt(ii),*) ' type of global domain lateral boundary jperio = ', kperio ; ii = ii+1 582 IF(lwp) THEN 583 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 584 WRITE(numout,*) ' Ni0glo = ', kpi 585 WRITE(numout,*) ' Nj0glo = ', kpj 586 WRITE(numout,*) ' jpkglo = ', kpk 587 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio 588 ENDIF 573 589 ! 574 590 END SUBROUTINE domain_cfg … … 591 607 !!---------------------------------------------------------------------- 592 608 INTEGER :: ji, jj, jk ! dummy loop indices 593 INTEGER :: izco, izps, isco, icav594 609 INTEGER :: inum ! local units 595 610 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) … … 606 621 ! 607 622 clnam = cn_domcfg_out ! filename (configuration information) 608 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 609 623 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 610 624 ! 611 625 ! !== ORCA family specificities ==! 612 IF( cn_cfg== "ORCA" ) THEN626 IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 613 627 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 614 628 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 615 629 ENDIF 616 630 ! 617 ! !== global domain size ==!618 !619 CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )620 CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )621 CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )622 !623 631 ! !== domain characteristics ==! 624 632 ! … … 627 635 ! 628 636 ! ! type of vertical coordinate 629 IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF 630 IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF 631 IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF 632 CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 ) 633 CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 ) 634 CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 ) 637 CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 638 CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 639 CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 635 640 ! 636 641 ! ! ocean cavities under iceshelves 637 IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF 638 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 642 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 639 643 ! 640 644 ! !== horizontal mesh !
Note: See TracChangeset
for help on using the changeset viewer.
