Changeset 7153
- Timestamp:
- 2016-10-28T11:13:57+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
r6393 r7153 8 8 nav_lev | model_levels | Z | T | cubic | Model levels | 9 9 deptht | m | Z | T | | Vertical T levels | depth 10 ncatice | 1 | Z | T | | Ice category | num_icecat_coordinate 10 11 time_counter | | T | | | Time axis | time 11 12 Bathymetry | m | XY | T | cubic | Bathymetry | bathymetry … … 108 109 kz | | XYZT | T | | | 109 110 irondep | | XYZT | T | | | 111 sivelu | m/s | XYT | T | | Ice velocity along i-axis at I-point | sea_ice_x_velocity 112 sivelv | m/s | XYT | T | | Ice velocity along j-axis at I-point | sea_ice_y_velocity 113 siconcat | % | XYZT | T | | Ice concentration for categories | sea_ice_cat_concentration 114 sithicat | m | XYZT | T | | Ice thickness for categories | sea_ice_cat_icethickness 115 snthicat | m | XYZT | T | | Snow thickness for categories | sea_ice_cat_snowthickness 110 116 kt_ice | | | | | | 111 117 hicif | | | | | | -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/attribute.f90
r6393 r7153 141 141 END TYPE TATT 142 142 143 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ), SAVE :: cm_dumatt !< dummy attribute143 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumatt !< dummy attribute 144 144 145 145 INTERFACE att_init … … 1282 1282 ! loop indices 1283 1283 ! namelist 1284 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumvar1285 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumdim1286 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumatt1284 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 1285 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 1286 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 1287 1287 1288 1288 !---------------------------------------------------------------- … … 1345 1345 1346 1346 att_is_dummy=.FALSE. 1347 DO ji=1,ip_maxdum 1347 DO ji=1,ip_maxdumcfg 1348 1348 IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN 1349 1349 att_is_dummy=.TRUE. -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
r7025 r7153 46 46 !> - cn_varcfg : variable configuration file 47 47 !> (see ./SIREN/cfg/variable.cfg) 48 !> - cn_dimcfg : dimension configuration file. define dimension allowed to 49 !> be used (see ./SIREN/cfg/dimension.cfg). 48 50 !> - cn_dumcfg : useless (dummy) configuration file, for useless 49 51 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). … … 134 136 !> @date February, 2016 135 137 !> - do not closed sea for east-west cyclic domain 138 !> @date October, 2016 139 !> - dimension to be used select from configuration file 136 140 ! 137 141 !> @todo … … 219 223 ! namcfg 220 224 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 225 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 221 226 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 222 227 … … 249 254 NAMELIST /namcfg/ & !< configuration namelist 250 255 & cn_varcfg, & !< variable configuration file 256 & cn_dimcfg, & !< dimension configuration file 251 257 & cn_dumcfg !< dummy configuration file 252 258 … … 308 314 ! get variable extra information 309 315 CALL var_def_extra(TRIM(cn_varcfg)) 316 317 ! get dimension allowed 318 CALL dim_def_extra(TRIM(cn_dimcfg)) 310 319 311 320 ! get dummy variable … … 615 624 CALL mpp_clean(tl_coord1) 616 625 CALL mpp_clean(tl_coord0) 626 CALL var_clean_extra() 617 627 618 628 ! close log file -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90
r7025 r7153 52 52 !> - cn_varcfg : variable configuration file 53 53 !> (see ./SIREN/cfg/variable.cfg) 54 !> - cn_dimcfg : dimension configuration file. define dimension allowed to 55 !> be used (see ./SIREN/cfg/dimension.cfg). 54 56 !> - cn_dumcfg : useless (dummy) configuration file, for useless 55 57 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). … … 199 201 !> @date January, 2016 200 202 !> - same process use for variable extracted or interpolated from input file. 203 !> @date October, 2016 204 !> - dimension to be used select from configuration file 201 205 !> 202 206 !> @todo … … 387 391 388 392 ! namcfg 389 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 390 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 393 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 394 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 395 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 391 396 392 397 ! namcrs … … 448 453 NAMELIST /namcfg/ & !< config namelist 449 454 & cn_varcfg, & !< variable configuration file 455 & cn_dimcfg, & !< dimension configuration file 450 456 & cn_dumcfg !< dummy configuration file 451 457 … … 529 535 CALL var_def_extra(TRIM(cn_varcfg)) 530 536 537 ! get dimension allowed 538 CALL dim_def_extra(TRIM(cn_dimcfg)) 539 531 540 ! get dummy variable 532 541 CALL var_get_dummy(TRIM(cn_dumcfg)) … … 1153 1162 CALL mpp_clean(tl_coord1) 1154 1163 CALL mpp_clean(tl_coord0) 1164 CALL var_clean_extra() 1155 1165 1156 1166 CALL multi_clean(tl_multi) … … 1615 1625 1616 1626 ENDIF 1627 1617 1628 END FUNCTION create_boundary_get_level 1618 1629 !------------------------------------------------------------------- -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
r7025 r7153 44 44 !> - cn_varcfg : variable configuration file 45 45 !> (see ./SIREN/cfg/variable.cfg) 46 !> - cn_dimcfg : dimension configuration file. define dimension allowed to 47 !> be used (see ./SIREN/cfg/dimension.cfg). 46 48 !> - cn_dumcfg : useless (dummy) configuration file, for useless 47 49 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). … … 110 112 !> @date September, 2016 111 113 !> - allow to use coordinate to define subdomain 114 !> @date October, 2016 115 !> - dimension to be used select from configuration file 112 116 !> 113 117 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 181 185 ! namcfg 182 186 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 187 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 183 188 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 184 189 … … 213 218 NAMELIST /namcfg/ & ! config namelist 214 219 & cn_varcfg, & !< variable configuration file 220 & cn_dimcfg, & !< dimension configuration file 215 221 & cn_dumcfg !< dummy configuration file 216 222 … … 277 283 CALL var_def_extra(TRIM(cn_varcfg)) 278 284 285 ! get dimension allowed 286 CALL dim_def_extra(TRIM(cn_dimcfg)) 287 279 288 ! get dummy variable 280 289 CALL var_get_dummy(TRIM(cn_dumcfg)) … … 340 349 IF( rn_lonmax0 >= -180. .AND. rn_lonmax0 <= 360 .AND. & 341 350 & rn_latmax0 >= -90. .AND. rn_latmax0 <= 90. )THEN 351 342 352 il_index(:)=grid_get_closest(tl_coord0, & 343 353 & REAL(rn_lonmax0,dp), REAL(rn_latmax0,dp), & … … 481 491 IF( il_attid == 0 )THEN 482 492 il_ind=var_get_index(tl_fileout%t_var(:),'longitude') 493 IF( il_ind == 0 )THEN 494 il_ind=var_get_index(tl_fileout%t_var(:),'longitude_T') 495 ENDIF 483 496 il_ew=grid_get_ew_overlap(tl_fileout%t_var(il_ind)) 484 497 IF( il_ew >= 0 )THEN … … 503 516 504 517 CALL file_clean(tl_fileout) 518 CALL var_clean_extra() 505 519 506 520 ! close log file -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_meshmask.f90
r7025 r7153 9 9 !> @brief 10 10 !> This program creates the NetCDF file(s) which contain(s) all the 11 !> ocean domain informations (mesh and mask arrays). 11 !> ocean domain informations. 12 !> It allows to create the domain_cfg.nc file needed to run NEMO, or 13 !> the mesh_mask file(s). 12 14 !> 13 15 !> @details … … 26 28 !> 27 29 !> @section sec2 how to 28 !> to create meshmask file:<br/>30 !> to create domain_cfg or meshmask file:<br/> 29 31 !> @code{.sh} 30 32 !> ./SIREN/bin/create_meshmask create_meshmask.nam … … 34 36 !> you could find a template of the namelist in templates directory. 35 37 !> 36 !> create_meshmask.nam contains 1 5namelists:<br/>38 !> create_meshmask.nam contains 13 namelists:<br/> 37 39 !> - logger namelist (namlog) 38 40 !> - config namelist (namcfg) … … 44 46 !> - partial step namelist (namzps) 45 47 !> - sigma or hybrid namelist (namsco) 46 ! >- cross land advection namelist (namcla)48 ! - cross land advection namelist (namcla) 47 49 !> - lateral boundary condition namelist (namlbc) 48 50 !> - wetting and dryong namelist (namwd) 49 51 !> - grid namelist (namgrd) 50 ! >- zoom namelist (namzoom)52 ! - zoom namelist (namzoom) 51 53 !> - output namelist (namout) 52 54 !> … … 138 140 !> - dn_zb_b : Offset for Zb 139 141 !> 140 ! >* _cross land advection namelist (namcla)_:<br/>141 ! >- in_cla : =1 cross land advection for exchanges through some straits (only for ORCA2)142 ! >142 ! * _cross land advection namelist (namcla)_:<br/> 143 ! - in_cla : =1 cross land advection for exchanges through some straits (only for ORCA2) 144 ! 143 145 !> * _lateral boundary condition namelist (namlbc)_:<br/> 144 146 !> - rn_shlat : lateral boundary conditions at the coast (modify fmask) … … 156 158 !> 157 159 !> * _grid namelist (namgrd)_:<br/> 158 ! >- cn_cfg : name of the configuration159 !> - in_cfg : resolution of the configuration160 !> - in_bench : benchmark parameter (in_mshhgr = 5 ).<br/>161 !> if /= 0 :forced the resolution to be about 100 km162 ! >- ln_zoom : use zoom (namzoom)160 ! - cn_cfg : name of the configuration 161 !> - in_cfg : inverse resolution of the configuration (1/4° => 4) 162 !> - ln_bench : GYRE (in_mshhgr = 5 ) used as Benchmark.<br/> 163 !> => forced the resolution to be about 100 km 164 ! - ln_zoom : use zoom (namzoom) 163 165 !> - ln_c1d : use configuration 1D 164 ! >165 ! >* _zoom namelist (namzoom)_:<br/>166 ! >- cn_cfz : name of the zoom of configuration167 ! >- in_izoom : left bottom i-indices of the zoom in data domain indices168 ! >- in_jzoom : left bottom j-indices of the zoom in data domain indices169 ! >- ln_zoom_s : South zoom type flag170 ! >- ln_zoom_e : East zoom type flag171 ! >- ln_zoom_w : West zoom type flag172 ! >- ln_zoom_n : North zoom type flag173 ! >166 ! 167 ! * _zoom namelist (namzoom)_:<br/> 168 ! - cn_cfz : name of the zoom of configuration 169 ! - in_izoom : left bottom i-indices of the zoom in data domain indices 170 ! - in_jzoom : left bottom j-indices of the zoom in data domain indices 171 ! - ln_zoom_s : South zoom type flag 172 ! - ln_zoom_e : East zoom type flag 173 ! - ln_zoom_w : West zoom type flag 174 ! - ln_zoom_n : North zoom type flag 175 ! 174 176 !> * _output namelist (namout)_:<br/> 175 !> - in_msh : number of output file and contain ( 1-9)177 !> - in_msh : number of output file and contain (0-9) 176 178 !> - in_nproc : number of processor to be used 177 179 !> - in_niproc : i-direction number of processor … … 179 181 !> 180 182 !> @note 181 !> MOD(in_msh, 3) = 1 : '<b>mesh_mask.nc</b>' file 182 !> = 2 : '<b>mesh.nc</b>' and '<b>mask.nc</b>' files 183 !> = 0 : '<b>mesh_hgr.nc</b>', '<b>mesh_zgr.nc</b>' and '<b>mask.nc</b>' files 183 !> if in_msh == 0 : write '<b>domain_cfg.nc</b>' file 184 !> MOD(in_msh, 3) = 1 : '<b>mesh_mask.nc</b>' file 185 !> = 2 : '<b>mesh.nc</b>' and '<b>mask.nc</b>' files 186 !> = 0 : '<b>mesh_hgr.nc</b>', '<b>mesh_zgr.nc</b>' and '<b>mask.nc</b>' files 184 187 !> 185 188 !> For huge size domain, use option 2 or 3 depending on your vertical coordinate. … … 197 200 !> @date October, 2016 198 201 !> - update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 202 !> @date October, 2016 203 !> - dimension to be used select from configuration file 204 !> - do not use anymore special case for ORCA grid 205 !> - allow to write domain_cfg file 199 206 !> 200 207 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 224 231 CHARACTER(LEN=lc) :: cl_date 225 232 233 INTEGER(i1), DIMENSION(:) , ALLOCATABLE :: bl_tmp 234 226 235 INTEGER(i4) :: il_narg 227 236 INTEGER(i4) :: il_status … … 232 241 INTEGER(i4) :: jpj 233 242 INTEGER(i4) :: jpk 243 INTEGER(i4), DIMENSION(:) , ALLOCATABLE :: il_tmp 234 244 INTEGER(i4), DIMENSION(:,:) , ALLOCATABLE :: il_mask 235 245 236 246 LOGICAL :: ll_exist 247 LOGICAL :: ll_domcfg 237 248 238 249 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_tmp2D … … 241 252 TYPE(TATT) :: tl_att 242 253 TYPE(TATT) , DIMENSION(:) , ALLOCATABLE :: tl_gatt 254 255 TYPE(TDIM) :: tl_dim 243 256 244 257 TYPE(TVAR) :: tl_bathy … … 249 262 TYPE(TVAR) :: tl_hdept 250 263 TYPE(TVAR) :: tl_hdepw 264 TYPE(TVAR) :: tl_scalar 251 265 252 266 TYPE(TNAMH) :: tl_namh … … 278 292 279 293 ! namcfg 280 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 281 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 294 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 295 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 296 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 282 297 283 298 ! namin … … 301 316 302 317 ! namout 303 INTEGER(i4) :: in_msh = 1318 INTEGER(i4) :: in_msh = 0 304 319 CHARACTER(LEN=lc) :: cn_type = 'cdf' 305 320 INTEGER(i4) :: in_nproc = 0 … … 314 329 NAMELIST /namcfg/ & !< configuration namelist 315 330 & cn_varcfg, & !< variable configuration file 331 & cn_dimcfg, & !< dimension configuration file 316 332 & cn_dumcfg !< dummy configuration file 317 333 … … 379 395 CALL var_def_extra(TRIM(cn_varcfg)) 380 396 397 ! get dimension allowed 398 CALL dim_def_extra(TRIM(cn_dimcfg)) 399 381 400 ! get dummy variable 382 401 CALL var_get_dummy(TRIM(cn_dumcfg)) … … 405 424 406 425 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 426 ll_domcfg=.FALSE. 427 IF( in_msh == 0 )THEN 428 ll_domcfg=.TRUE. 429 ENDIF 407 430 408 431 ! open file … … 443 466 & tl_bathy%d_value(:,:,1,1) < 0._dp ) 444 467 tl_bathy%d_value(:,:,1,1) = 0._dp 445 END WHERE468 END WHERE 446 469 447 470 IF ( ln_isfcav ) THEN … … 495 518 496 519 ! init Horizontal grid global variable 497 CALL grid_hgr_init(jpi,jpj,jpk )520 CALL grid_hgr_init(jpi,jpj,jpk,ll_domcfg) 498 521 499 522 ! compute horizontal mesh 500 523 WRITE(*,*) "COMPUTE HORIZONTAL MESH" 501 CALL grid_hgr_fill(tl_namh,jpi,jpj )524 CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg) 502 525 503 526 ! Vertyical mesh (dom_zgr) ------------------------------------------------- … … 505 528 506 529 ! init Vertical grid global variable 507 CALL grid_zgr_init(jpi,jpj,jpk )530 CALL grid_zgr_init(jpi,jpj,jpk,ln_sco) 508 531 IF( ln_zps ) CALL grid_zgr_zps_init(jpi,jpj) 509 532 IF( ln_sco ) CALL grid_zgr_sco_init(jpi,jpj) … … 515 538 ! compute masks 516 539 WRITE(*,*) "COMPUTE MASK" 517 CALL create__mask(tl_namh,jpi,jpj,jpk )540 CALL create__mask(tl_namh,jpi,jpj,jpk,ll_domcfg) 518 541 519 542 ! Maximum stiffness ratio/hydrostatic consistency … … 534 557 535 558 WRITE(*,*) "WRITE FILE(S)" 536 SELECT CASE ( MOD(in_msh, 3) ) 537 ! ! ============================ 538 CASE ( 1 ) ! create 'mesh_mask.nc' file 539 ! ! ============================ 540 tl_mppout0=mpp_init( 'mesh_mask', tg_tmask, & 541 & in_niproc, in_njproc, in_nproc, & 542 & cd_type=cn_type ) 543 544 tl_mppmsk=>tl_mppout0 545 tl_mpphgr=>tl_mppout0 546 tl_mppzgr=>tl_mppout0 559 IF( ll_domcfg )THEN 560 ! ! ============================ 561 ! ! create 'domain_cfg.nc' file 562 ! ! ============================ 563 tl_mppout0=mpp_init( 'domain_cfg', tg_tmask, & 564 & in_niproc, in_njproc, in_nproc, & 565 & cd_type=cn_type ) 566 567 tl_mppmsk=>tl_mppout0 568 tl_mpphgr=>tl_mppout0 569 tl_mppzgr=>tl_mppout0 570 571 ELSE 572 SELECT CASE ( MOD(in_msh, 3) ) 573 ! ! ============================ 574 CASE ( 1 ) ! create 'mesh_mask.nc' file 575 ! ! ============================ 576 tl_mppout0=mpp_init( 'mesh_mask', tg_tmask, & 577 & in_niproc, in_njproc, in_nproc, & 578 & cd_type=cn_type ) 579 580 tl_mppmsk=>tl_mppout0 581 tl_mpphgr=>tl_mppout0 582 tl_mppzgr=>tl_mppout0 583 584 ! ! ============================ 585 CASE ( 2 ) ! create 'mesh.nc' and 586 ! ! 'mask.nc' files 587 ! ! ============================ 588 tl_mppout0=mpp_init( 'mask', tg_tmask, & 589 & in_niproc, in_njproc, in_nproc, & 590 & cd_type=cn_type ) 591 tl_mppout1=mpp_init( 'mesh', tg_tmask, & 592 & in_niproc, in_njproc, in_nproc, & 593 & cd_type=cn_type ) 594 595 tl_mppmsk=>tl_mppout0 596 tl_mpphgr=>tl_mppout1 597 tl_mppzgr=>tl_mppout1 598 599 ! ! ============================ 600 CASE ( 0 ) ! create 'mesh_hgr.nc' 601 ! ! 'mesh_zgr.nc' and 602 ! ! 'mask.nc' files 603 ! ! ============================ 604 tl_mppout0=mpp_init( 'mask', tg_tmask, & 605 & in_niproc, in_njproc, in_nproc, & 606 & cd_type=cn_type ) 607 tl_mppout1=mpp_init( 'mesh_hgr', tg_tmask, & 608 & in_niproc, in_njproc, in_nproc, & 609 & cd_type=cn_type ) 610 tl_mppout2=mpp_init( 'mesh_zgr', tg_tmask, & 611 & in_niproc, in_njproc, in_nproc, & 612 & cd_type=cn_type ) 613 ! 614 615 tl_mppmsk=>tl_mppout0 616 tl_mpphgr=>tl_mppout1 617 tl_mppzgr=>tl_mppout2 618 619 END SELECT 620 ENDIF 621 622 ! add variables 623 IF( ll_domcfg )THEN 624 ALLOCATE(il_tmp(1)) 625 tl_dim%l_use=.FALSE. 626 627 il_tmp(:)=jpi 628 tl_scalar=var_init('jpiglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) 629 CALL mpp_add_var(tl_mppmsk, tl_scalar) 630 631 il_tmp(:)=jpj 632 tl_scalar=var_init('jpjglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) 633 CALL mpp_add_var(tl_mppmsk, tl_scalar) 634 635 il_tmp(:)=jpk 636 tl_scalar=var_init('jpkglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) 637 CALL mpp_add_var(tl_mppmsk, tl_scalar) 547 638 548 ! ! ============================ 549 CASE ( 2 ) ! create 'mesh.nc' and 550 ! ! 'mask.nc' files 551 ! ! ============================ 552 tl_mppout0=mpp_init( 'mask', tg_tmask, & 553 & in_niproc, in_njproc, in_nproc, & 554 & cd_type=cn_type ) 555 tl_mppout1=mpp_init( 'mesh', tg_tmask, & 556 & in_niproc, in_njproc, in_nproc, & 557 & cd_type=cn_type ) 558 559 tl_mppmsk=>tl_mppout0 560 tl_mpphgr=>tl_mppout1 561 tl_mppzgr=>tl_mppout1 562 563 ! ! ============================ 564 CASE ( 0 ) ! create 'mesh_hgr.nc' 565 ! ! 'mesh_zgr.nc' and 566 ! ! 'mask.nc' files 567 ! ! ============================ 568 tl_mppout0=mpp_init( 'mask', tg_tmask, & 569 & in_niproc, in_njproc, in_nproc, & 570 & cd_type=cn_type ) 571 tl_mppout1=mpp_init( 'mesh_hgr', tg_tmask, & 572 & in_niproc, in_njproc, in_nproc, & 573 & cd_type=cn_type ) 574 tl_mppout2=mpp_init( 'mesh_zgr', tg_tmask, & 575 & in_niproc, in_njproc, in_nproc, & 576 & cd_type=cn_type ) 577 ! 578 579 tl_mppmsk=>tl_mppout0 580 tl_mpphgr=>tl_mppout1 581 tl_mppzgr=>tl_mppout2 582 583 END SELECT 584 585 ! add variables 639 il_tmp(:)=tl_mppout0%i_perio 640 tl_scalar=var_init('jperio', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim) 641 CALL mpp_add_var(tl_mppmsk, tl_scalar) 642 643 DEALLOCATE(il_tmp) 644 ALLOCATE(bl_tmp(1)) 645 646 bl_tmp(:)=0 647 IF( ln_zco ) bl_tmp(:)=1 648 tl_scalar=var_init('ln_zco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim) 649 CALL mpp_add_var(tl_mppmsk, tl_scalar) 650 651 bl_tmp(:)=0 652 IF( ln_zps ) bl_tmp(:)=1 653 tl_scalar=var_init('ln_zps',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim) 654 CALL mpp_add_var(tl_mppmsk, tl_scalar) 655 656 bl_tmp(:)=0 657 IF( ln_sco ) bl_tmp(:)=1 658 tl_scalar=var_init('ln_sco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim) 659 CALL mpp_add_var(tl_mppmsk, tl_scalar) 660 661 bl_tmp(:)=0 662 IF( ln_isfcav ) bl_tmp(:)=1 663 tl_scalar=var_init('ln_isfcav',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim) 664 CALL mpp_add_var(tl_mppmsk, tl_scalar) 665 666 DEALLOCATE(bl_tmp) 667 CALL var_clean(tl_scalar) 668 ENDIF 669 586 670 !!! mask (msk) 587 671 !!!---------------------- 588 589 ! tmask 590 CALL mpp_add_var(tl_mppmsk, tg_tmask) 591 CALL var_clean(tg_tmask) 592 ! umask 593 CALL mpp_add_var(tl_mppmsk, tg_umask) 594 CALL var_clean(tg_umask) 595 ! vmask 596 CALL mpp_add_var(tl_mppmsk, tg_vmask) 597 CALL var_clean(tg_vmask) 598 ! fmask 599 CALL mpp_add_var(tl_mppmsk, tg_fmask) 600 CALL var_clean(tg_fmask) 601 602 !!! VOIR CAS TMASKUTIL ??? 603 672 IF( .NOT. ll_domcfg )THEN 673 ! tmask 674 CALL mpp_add_var(tl_mppmsk, tg_tmask) 675 CALL var_clean(tg_tmask) 676 ! umask 677 CALL mpp_add_var(tl_mppmsk, tg_umask) 678 CALL var_clean(tg_umask) 679 ! vmask 680 CALL mpp_add_var(tl_mppmsk, tg_vmask) 681 CALL var_clean(tg_vmask) 682 ! fmask 683 CALL mpp_add_var(tl_mppmsk, tg_fmask) 684 CALL var_clean(tg_fmask) 685 ENDIF 686 604 687 !!! horizontal mesh (hgr) 605 688 !!!---------------------- … … 662 745 663 746 ! coriolis factor 664 ! ff 665 CALL mpp_add_var(tl_mpphgr, tg_ff) 666 CALL var_clean(tg_ff) 747 ! ff_t 748 CALL mpp_add_var(tl_mpphgr, tg_ff_t) 749 CALL var_clean(tg_ff_t) 750 ! ff_f 751 CALL mpp_add_var(tl_mpphgr, tg_ff_f) 752 CALL var_clean(tg_ff_f) 667 753 668 754 ! angles 669 ! cost 670 CALL mpp_add_var(tl_mpphgr, tg_gcost) 671 CALL var_clean(tg_gcost) 672 ! cosu 673 CALL mpp_add_var(tl_mpphgr, tg_gcosu) 674 CALL var_clean(tg_gcosu) 675 ! cosv 676 CALL mpp_add_var(tl_mpphgr, tg_gcosv) 677 CALL var_clean(tg_gcosv) 678 ! cosf 679 CALL mpp_add_var(tl_mpphgr, tg_gcosf) 680 CALL var_clean(tg_gcosf) 681 682 ! sint 683 CALL mpp_add_var(tl_mpphgr, tg_gsint) 684 CALL var_clean(tg_gsint) 685 ! sinu 686 CALL mpp_add_var(tl_mpphgr, tg_gsinu) 687 CALL var_clean(tg_gsinu) 688 ! sinv 689 CALL mpp_add_var(tl_mpphgr, tg_gsinv) 690 CALL var_clean(tg_gsinv) 691 ! sinf 692 CALL mpp_add_var(tl_mpphgr, tg_gsinf) 693 CALL var_clean(tg_gsinf) 755 IF( .NOT. ll_domcfg )THEN 756 ! cost 757 CALL mpp_add_var(tl_mpphgr, tg_gcost) 758 CALL var_clean(tg_gcost) 759 ! cosu 760 CALL mpp_add_var(tl_mpphgr, tg_gcosu) 761 CALL var_clean(tg_gcosu) 762 ! cosv 763 CALL mpp_add_var(tl_mpphgr, tg_gcosv) 764 CALL var_clean(tg_gcosv) 765 ! cosf 766 CALL mpp_add_var(tl_mpphgr, tg_gcosf) 767 CALL var_clean(tg_gcosf) 768 769 ! sint 770 CALL mpp_add_var(tl_mpphgr, tg_gsint) 771 CALL var_clean(tg_gsint) 772 ! sinu 773 CALL mpp_add_var(tl_mpphgr, tg_gsinu) 774 CALL var_clean(tg_gsinu) 775 ! sinv 776 CALL mpp_add_var(tl_mpphgr, tg_gsinv) 777 CALL var_clean(tg_gsinv) 778 ! sinf 779 CALL mpp_add_var(tl_mpphgr, tg_gsinf) 780 CALL var_clean(tg_gsinf) 781 ENDIF 694 782 695 783 !!! vertical mesh (zgr) 696 784 !!!---------------------- 697 698 785 ! note that mbkt is set to 1 over land ==> use surface tmask 699 786 ! 700 787 ! mbathy 701 788 tg_mbathy%d_value(:,:,:,:) = tg_ssmask%d_value(:,:,:,:) * & 702 &tg_mbkt%d_value(:,:,:,:)789 & tg_mbkt%d_value(:,:,:,:) 703 790 ! 791 IF( ll_domcfg ) tg_mbathy%c_name='bottom_level' 704 792 CALL mpp_add_var(tl_mppzgr, tg_mbathy) 705 793 CALL var_clean(tg_mbathy) … … 709 797 dl_tmp2D(:,:)=dp_fill 710 798 711 tl_misf =var_init('misf ',dl_tmp2D(:,:), id_type=NF90_INT)799 tl_misf =var_init('misf ',dl_tmp2D(:,:), id_type=NF90_INT) 712 800 713 801 DEALLOCATE(dl_tmp2D) 714 802 tl_misf%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1) * & 715 &tg_mikt%d_value(:,:,1,1)803 & tg_mikt%d_value(:,:,1,1) 716 804 ! 805 IF( ll_domcfg ) tl_misf%c_name='top_level' 717 806 CALL mpp_add_var(tl_mppzgr, tl_misf) 718 807 CALL var_clean(tl_misf) 719 808 720 ! isfdraft 721 tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * & 722 & tg_mikt%d_value(:,:,:,:) 723 CALL mpp_add_var(tl_mppzgr, tl_risfdep) 724 CALL var_clean(tl_risfdep) 809 IF( .NOT. ll_domcfg )THEN 810 ! isfdraft 811 tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * & 812 & tg_mikt%d_value(:,:,:,:) 813 814 CALL mpp_add_var(tl_mppzgr, tl_risfdep) 815 CALL var_clean(tl_risfdep) 816 ENDIF 725 817 726 818 IF( ln_sco ) THEN ! s-coordinate 727 819 728 ! hbatt 729 CALL mpp_add_var(tl_mppzgr, tg_hbatt) 730 CALL var_clean(tg_hbatt) 731 ! hbatu 732 CALL mpp_add_var(tl_mppzgr, tg_hbatu) 733 CALL var_clean(tg_hbatu) 734 ! hbatv 735 CALL mpp_add_var(tl_mppzgr, tg_hbatv) 736 CALL var_clean(tg_hbatv) 737 ! hbatf 738 CALL mpp_add_var(tl_mppzgr, tg_hbatf) 739 CALL var_clean(tg_hbatf) 740 741 ! scaling coef. 742 IF( .NOT. (tl_namz%l_s_sh94 .OR. tl_namz%l_s_sf12) )THEN 743 ! gsigt 744 CALL mpp_add_var(tl_mppzgr, tg_gsigt) 745 CALL var_clean(tg_gsigt) 746 ! gsigw 747 CALL mpp_add_var(tl_mppzgr, tg_gsigw) 748 CALL var_clean(tg_gsigw) 749 ! gsi3w 750 CALL mpp_add_var(tl_mppzgr, tg_gsi3w) 751 CALL var_clean(tg_gsi3w) 752 ! esigt 753 CALL mpp_add_var(tl_mppzgr, tg_esigt) 754 CALL var_clean(tg_esigt) 755 ! esigw 756 CALL mpp_add_var(tl_mppzgr, tg_esigw) 757 CALL var_clean(tg_esigw) 820 IF( .NOT. ll_domcfg )THEN 821 ! hbatt 822 CALL mpp_add_var(tl_mppzgr, tg_hbatt) 823 CALL var_clean(tg_hbatt) 824 ! hbatu 825 CALL mpp_add_var(tl_mppzgr, tg_hbatu) 826 CALL var_clean(tg_hbatu) 827 ! hbatv 828 CALL mpp_add_var(tl_mppzgr, tg_hbatv) 829 CALL var_clean(tg_hbatv) 830 ! hbatf 831 CALL mpp_add_var(tl_mppzgr, tg_hbatf) 832 CALL var_clean(tg_hbatf) 833 834 ! scaling coef. 835 IF( .NOT. (tl_namz%l_s_sh94 .OR. tl_namz%l_s_sf12) )THEN 836 ! gsigt 837 CALL mpp_add_var(tl_mppzgr, tg_gsigt) 838 CALL var_clean(tg_gsigt) 839 ! gsigw 840 CALL mpp_add_var(tl_mppzgr, tg_gsigw) 841 CALL var_clean(tg_gsigw) 842 ! gsi3w 843 CALL mpp_add_var(tl_mppzgr, tg_gsi3w) 844 CALL var_clean(tg_gsi3w) 845 ! esigt 846 CALL mpp_add_var(tl_mppzgr, tg_esigt) 847 CALL var_clean(tg_esigt) 848 ! esigw 849 CALL mpp_add_var(tl_mppzgr, tg_esigw) 850 CALL var_clean(tg_esigw) 851 ENDIF 758 852 ENDIF 759 853 … … 774 868 ! Max. grid stiffness ratio 775 869 ! rx1 870 IF( ll_domcfg ) tg_rx1%c_name='stiffness' 776 871 CALL mpp_add_var(tl_mppzgr, tg_rx1) 777 872 CALL var_clean(tg_rx1) … … 796 891 IF( ln_zps ) THEN ! z-coordinate - partial steps 797 892 798 IF( in_msh <= 6 ) THEN ! 3D vertical scale factors893 IF( ll_domcfg .OR. in_msh <= 6 ) THEN ! 3D vertical scale factors 799 894 800 895 ! e3t_0 … … 831 926 ENDIF ! 3D vertical scale factors 832 927 833 IF( in_msh <= 3 ) THEN ! 3D depth928 IF( ll_domcfg .OR. in_msh <= 3 ) THEN ! 3D depth 834 929 835 930 ! gdept_0 … … 837 932 838 933 ! gdepu, gdepv 839 ALLOCATE(dl_tmp3D(jpi,jpj,jpk)) 840 dl_tmp3D(:,:,:)=dp_fill 841 842 tl_gdepu=var_init('gdepu',dl_tmp3D(:,:,:), id_type=NF90_FLOAT) 843 tl_gdepv=var_init('gdepv',dl_tmp3D(:,:,:), id_type=NF90_FLOAT) 844 845 DEALLOCATE(dl_tmp3D) 846 DO jk = 1,jpk 847 DO jj = 1, jpj-1 848 DO ji = 1, jpi-1 ! vector opt. 849 tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & 850 & tg_gdept_0%d_value(ji+1,jj ,jk,1) ) 851 852 tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & 853 & tg_gdept_0%d_value(ji ,jj+1,jk,1) ) 934 IF( .NOT. ll_domcfg )THEN 935 ALLOCATE(dl_tmp3D(jpi,jpj,jpk)) 936 dl_tmp3D(:,:,:)=dp_fill 937 938 tl_gdepu=var_init('gdepu',dl_tmp3D(:,:,:), id_type=NF90_FLOAT) 939 tl_gdepv=var_init('gdepv',dl_tmp3D(:,:,:), id_type=NF90_FLOAT) 940 941 DEALLOCATE(dl_tmp3D) 942 DO jk = 1,jpk 943 DO jj = 1, jpj-1 944 DO ji = 1, jpi-1 ! vector opt. 945 tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & 946 & tg_gdept_0%d_value(ji+1,jj ,jk,1) ) 947 948 tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , & 949 & tg_gdept_0%d_value(ji ,jj+1,jk,1) ) 950 END DO 854 951 END DO 855 END DO 856 END DO857 CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp )858 CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp ) 859 860 ! gdepu861 CALL mpp_add_var(tl_mppzgr,tl_gdepu)862 CALL var_clean(tl_gdepu)863 ! gdepv864 CALL mpp_add_var(tl_mppzgr,tl_gdepv)865 CALL var_clean(tl_gdepv)952 END DO 953 CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp ) 954 CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp ) 955 956 ! gdepu 957 CALL mpp_add_var(tl_mppzgr, tl_gdepu) 958 CALL var_clean(tl_gdepu) 959 ! gdepv 960 CALL mpp_add_var(tl_mppzgr, tl_gdepv) 961 CALL var_clean(tl_gdepv) 962 ENDIF 866 963 867 964 ! clean … … 1133 1230 DEALLOCATE(tl_gatt) 1134 1231 1135 CALL grid_hgr_clean( )1136 CALL grid_zgr_clean( )1232 CALL grid_hgr_clean(ll_domcfg) 1233 CALL grid_zgr_clean(ln_sco) 1137 1234 IF( ln_zps ) CALL grid_zgr_zps_clean() 1138 1235 IF( ln_sco ) CALL grid_zgr_sco_clean() 1236 CALL var_clean_extra() 1139 1237 1140 1238 ! close log file … … 1198 1296 !> @author J.Paul 1199 1297 !> @date September, 2015 - rewrite from dom_msk 1298 !> @date October, 2016 1299 !> - do not use anymore special case for ORCA grid 1200 1300 !> 1201 1301 !> @param[in] td_nam … … 1204 1304 !> @param[in] jpk 1205 1305 !------------------------------------------------------------------- 1206 SUBROUTINE create__mask(td_nam,jpi,jpj,jpk )1306 SUBROUTINE create__mask(td_nam,jpi,jpj,jpk,ld_domcfg) 1207 1307 IMPLICIT NONE 1208 1308 ! Argument 1209 TYPE(TNAMH), INTENT(IN ) :: td_nam 1210 INTEGER(i4), INTENT(IN ) :: jpi 1211 INTEGER(i4), INTENT(IN ) :: jpj 1212 INTEGER(i4), INTENT(IN ) :: jpk 1309 TYPE(TNAMH), INTENT(IN) :: td_nam 1310 INTEGER(i4), INTENT(IN) :: jpi 1311 INTEGER(i4), INTENT(IN) :: jpj 1312 INTEGER(i4), INTENT(IN) :: jpk 1313 LOGICAL , INTENT(IN) :: ld_domcfg 1213 1314 1214 1315 ! local variable 1215 INTEGER(i4) :: ii0, ii1 ! local integers1216 INTEGER(i4) :: ij0, ij11217 INTEGER(i4) :: isrow1316 ! INTEGER(i4) :: ii0, ii1 ! local integers 1317 ! INTEGER(i4) :: ij0, ij1 1318 ! INTEGER(i4) :: isrow 1218 1319 1219 1320 ! INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: imsk … … 1230 1331 1231 1332 ! ALLOCATE( imsk(jpi,jpj) ) 1232 ALLOCATE( zwf(jpi,jpj) )1233 1333 1234 1334 ! ALLOCATE( dl_tpol(jpi) ) … … 1304 1404 ! ENDIF 1305 1405 1406 IF( .NOT. ld_domcfg )THEN 1306 1407 ! 2. Ocean/land mask at u-, v-, and z-points (computed from tmask) 1307 1408 ! ------------------------------------------- … … 1366 1467 ! Lateral boundary conditions on velocity (modify fmask) 1367 1468 ! --------------------------------------- 1469 ALLOCATE( zwf(jpi,jpj) ) 1368 1470 DO jk = 1, jpk 1369 1471 zwf(:,:) = tg_fmask%d_value(:,:,jk,1) … … 1398 1500 END DO 1399 1501 END DO 1400 1401 IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 2 )THEN ! ORCA_R2 configuration 1402 ! ! Increased lateral friction near of some straits 1403 IF( td_nam%i_cla == 0 ) THEN 1404 ! Gibraltar strait : partial slip (fmask=0.5) 1405 ij0 = 101 ; ij1 = 101 1406 ii0 = 139 ; ii1 = 140 1407 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp 1408 1409 ij0 = 102 ; ij1 = 102 1410 ii0 = 139 ; ii1 = 140 1411 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp 1412 ! 1413 !Bab el Mandeb : partial slip (fmask=1) 1414 ij0 = 87 ; ij1 = 88 1415 ii0 = 160 ; ii1 = 160 1416 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp 1417 1418 ij0 = 88 ; ij1 = 88 1419 ii0 = 159 ; ii1 = 159 1420 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp 1421 ! 1422 ENDIF 1423 ENDIF 1424 ! 1425 IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 1 )THEN ! ORCA R1 configuration 1426 ! Increased lateral friction near of some straits 1427 ! This dirty section will be suppressed by simplification process: 1428 ! all this will come back in input files 1429 ! Currently these hard-wired indices relate to configuration with 1430 ! extend grid (jpjglo=332) 1431 ! 1432 isrow = 332 - jpj 1433 ! Gibraltar Strait 1434 ii0 = 282 ; ii1 = 283 1435 ij0 = 201 + isrow ; ij1 = 241 - isrow 1436 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp 1437 1438 ! Bhosporus Strait 1439 ii0 = 314 ; ii1 = 315 1440 ij0 = 208 + isrow ; ij1 = 248 - isrow 1441 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1442 1443 ! Makassar Strait (Top) 1444 ii0 = 48 ; ii1 = 48 1445 ij0 = 149 + isrow ; ij1 = 190 - isrow 1446 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1447 1448 ! Lombok Strait 1449 ii0 = 44 ; ii1 = 44 1450 ij0 = 124 + isrow ; ij1 = 165 - isrow 1451 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1452 1453 ! Ombai Strait 1454 ii0 = 53 ; ii1 = 53 1455 ij0 = 124 + isrow ; ij1 = 165 - isrow 1456 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1457 1458 ! Timor Passage 1459 ii0 = 56 ; ii1 = 56 1460 ij0 = 124 + isrow ; ij1 = 165 - isrow 1461 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1462 1463 ! West Halmahera Strait 1464 ii0 = 58 ; ii1 = 58 1465 ij0 = 141 + isrow ; ij1 = 182 - isrow 1466 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1467 1468 ! East Halmahera Strait 1469 ii0 = 55 ; ii1 = 55 1470 ij0 = 141 + isrow ; ij1 = 182 - isrow 1471 tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1472 ! 1473 ENDIF 1502 DEALLOCATE( zwf ) 1503 1504 ! IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 2 )THEN ! ORCA_R2 configuration 1505 ! ! ! Increased lateral friction near of some straits 1506 ! IF( td_nam%i_cla == 0 ) THEN 1507 ! ! Gibraltar strait : partial slip (fmask=0.5) 1508 ! ij0 = 101 ; ij1 = 101 1509 ! ii0 = 139 ; ii1 = 140 1510 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp 1511 ! 1512 ! ij0 = 102 ; ij1 = 102 1513 ! ii0 = 139 ; ii1 = 140 1514 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp 1515 ! ! 1516 ! !Bab el Mandeb : partial slip (fmask=1) 1517 ! ij0 = 87 ; ij1 = 88 1518 ! ii0 = 160 ; ii1 = 160 1519 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp 1520 ! 1521 ! ij0 = 88 ; ij1 = 88 1522 ! ii0 = 159 ; ii1 = 159 1523 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp 1524 ! ! 1525 ! ENDIF 1526 ! ENDIF 1527 ! ! 1528 ! IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 1 )THEN ! ORCA R1 configuration 1529 ! ! Increased lateral friction near of some straits 1530 ! ! This dirty section will be suppressed by simplification process: 1531 ! ! all this will come back in input files 1532 ! ! Currently these hard-wired indices relate to configuration with 1533 ! ! extend grid (jpjglo=332) 1534 ! ! 1535 ! isrow = 332 - jpj 1536 ! ! Gibraltar Strait 1537 ! ii0 = 282 ; ii1 = 283 1538 ! ij0 = 201 + isrow ; ij1 = 241 - isrow 1539 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp 1540 ! 1541 ! ! Bhosporus Strait 1542 ! ii0 = 314 ; ii1 = 315 1543 ! ij0 = 208 + isrow ; ij1 = 248 - isrow 1544 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1545 ! 1546 ! ! Makassar Strait (Top) 1547 ! ii0 = 48 ; ii1 = 48 1548 ! ij0 = 149 + isrow ; ij1 = 190 - isrow 1549 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1550 ! 1551 ! ! Lombok Strait 1552 ! ii0 = 44 ; ii1 = 44 1553 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1554 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1555 ! 1556 ! ! Ombai Strait 1557 ! ii0 = 53 ; ii1 = 53 1558 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1559 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1560 ! 1561 ! ! Timor Passage 1562 ! ii0 = 56 ; ii1 = 56 1563 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 1564 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp 1565 ! 1566 ! ! West Halmahera Strait 1567 ! ii0 = 58 ; ii1 = 58 1568 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 1569 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1570 ! 1571 ! ! East Halmahera Strait 1572 ! ii0 = 55 ; ii1 = 55 1573 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 1574 ! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp 1575 ! ! 1576 ! ENDIF 1474 1577 ! 1475 1578 CALL lbc_lnk( tg_fmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp ) ! Lateral boundary conditions on fmask 1476 1579 1477 1580 ! DEALLOCATE( imsk ) 1478 DEALLOCATE( zwf )1581 ENDIF ! ld_domcfg 1479 1582 1480 1583 ! DEALLOCATE( dl_tpol ) -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
r7025 r7153 48 48 !> - cn_varcfg : variable configuration file 49 49 !> (see ./SIREN/cfg/variable.cfg) 50 !> - cn_dimcfg : dimension configuration file. define dimension allowed to 51 !> be used (see ./SIREN/cfg/dimension.cfg). 50 52 !> - cn_dumcfg : useless (dummy) configuration file, for useless 51 53 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). … … 160 162 !> @date September, 2015 161 163 !> - manage useless (dummy) variable, attributes, and dimension 164 !> @date October, 2016 165 !> - dimension to be used select from configuration file 162 166 !> 163 167 !> @todo … … 201 205 INTEGER(i4) :: il_status 202 206 INTEGER(i4) :: il_fileid 207 INTEGER(i4) :: il_attid 203 208 INTEGER(i4) :: il_nvar 204 INTEGER(i4) :: il_attid205 209 INTEGER(i4) :: il_imin1 206 210 INTEGER(i4) :: il_imax1 … … 254 258 255 259 ! namcfg 256 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 257 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 260 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 261 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 262 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 258 263 259 264 ! namcrs … … 308 313 NAMELIST /namcfg/ & !< configuration namelist 309 314 & cn_varcfg, & !< variable configuration file 315 & cn_dimcfg, & !< dimension configuration file 310 316 & cn_dumcfg !< dummy configuration file 311 317 … … 313 319 & cn_coord0, & !< coordinate file 314 320 & in_perio0 !< periodicity index 315 321 316 322 NAMELIST /namfin/ & !< fine grid namelist 317 323 & cn_coord1, & !< coordinate file … … 339 345 & cn_varfile, & !< list of variable file 340 346 & cn_varinfo !< list of variable and interpolation method to be used. 341 347 342 348 NAMELIST /namnst/ & !< nesting namelist 343 349 & in_rhoi, & !< refinement factor in i-direction … … 389 395 ! get variable extra information 390 396 CALL var_def_extra(TRIM(cn_varcfg)) 397 398 ! get dimension allowed 399 CALL dim_def_extra(TRIM(cn_dimcfg)) 391 400 392 401 ! get dummy variable … … 900 909 CALL mpp_clean(tl_mppout) 901 910 CALL mpp_clean(tl_coord1) 911 CALL var_clean_extra() 902 912 903 913 ! close log file … … 1204 1214 & tl_depth%d_value(:,:,:,:) ) )THEN 1205 1215 1206 CALL logger_warn("CREATE BOUNDARY: depth value from "//&1216 CALL logger_warn("CREATE RESTART: depth value from "//& 1207 1217 & TRIM(td_mpp%c_name)//" not conform "//& 1208 1218 & " to those from former file(s).") -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/dimension.f90
r6393 r7153 156 156 !> @date Spetember, 2015 157 157 !> - manage useless (dummy) dimension 158 !> @date October, 2016 159 !> - dimension allowed read in configuration file 158 160 !> 159 161 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 171 173 172 174 PRIVATE :: cm_dumdim !< dummy dimension array 175 PRIVATE :: cm_dimX !< x dimension array 176 PRIVATE :: cm_dimY !< y dimension array 177 PRIVATE :: cm_dimZ !< z dimension array 178 PRIVATE :: cm_dimT !< t dimension array 173 179 174 180 ! function and subroutine … … 188 194 PUBLIC :: dim_get_dummy !< fill dummy dimension array 189 195 PUBLIC :: dim_is_dummy !< check if dimension is defined as dummy dimension 196 PUBLIC :: dim_def_extra !< read dimension configuration file, and save dimension allowed. 190 197 191 198 PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') … … 203 210 PRIVATE :: dim__copy_unit ! copy dimension structure 204 211 PRIVATE :: dim__copy_arr ! copy array of dimension structure 212 PRIVATE :: dim__is_allowed 205 213 206 214 TYPE TDIM !< dimension structure … … 215 223 END TYPE 216 224 217 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension 225 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim !< dummy dimension 226 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX !< x dimension 227 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY !< y dimension 228 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ !< z dimension 229 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT !< t dimension 218 230 219 231 INTERFACE dim_print … … 587 599 cl_name=fct_lower(cd_name) 588 600 589 IF( TRIM(cl_name) == 'x')THEN601 IF( dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN 590 602 dim_init%c_sname='x' 591 ELSEIF( TRIM(cl_name) == 'y')THEN603 ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN 592 604 dim_init%c_sname='y' 593 ELSEIF( TRIM(cl_name)== 'z' .OR. & 594 & INDEX(cl_name,'depth')/=0 )THEN 605 ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:)) )THEN 595 606 dim_init%c_sname='z' 596 ELSEIF( TRIM(cl_name)== 't' .OR. & 597 & INDEX(cl_name,'time')/=0 )THEN 607 ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:)) )THEN 598 608 dim_init%c_sname='t' 599 ENDIF 609 ELSE 610 CALL logger_warn("DIM INIT: "//TRIM(cd_name)//& 611 " not allowed.") 612 ENDIF 600 613 601 614 ENDIF … … 1430 1443 ! loop indices 1431 1444 ! namelist 1432 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumvar1433 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumdim1434 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumatt1445 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 1446 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 1447 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 1435 1448 1436 1449 !---------------------------------------------------------------- … … 1493 1506 1494 1507 dim_is_dummy=.FALSE. 1495 DO ji=1,ip_maxdum 1508 DO ji=1,ip_maxdumcfg 1496 1509 IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 1497 1510 dim_is_dummy=.TRUE. … … 1501 1514 1502 1515 END FUNCTION dim_is_dummy 1516 !------------------------------------------------------------------- 1517 !> @brief This subroutine read dimension configuration file, 1518 !> and fill array of dimension allowed. 1519 !> 1520 !> @author J.Paul 1521 !> @date Ocotber, 2016 - Initial Version 1522 ! 1523 !> @param[in] cd_file input file (dimension configuration file) 1524 !------------------------------------------------------------------- 1525 SUBROUTINE dim_def_extra( cd_file ) 1526 IMPLICIT NONE 1527 1528 ! Argument 1529 CHARACTER(LEN=*), INTENT(IN) :: cd_file 1530 1531 ! local variable 1532 INTEGER(i4) :: il_fileid 1533 INTEGER(i4) :: il_status 1534 1535 LOGICAL :: ll_exist 1536 1537 ! loop indices 1538 ! namelist 1539 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = '' 1540 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = '' 1541 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimZ = '' 1542 CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimT = '' 1543 1544 !---------------------------------------------------------------- 1545 NAMELIST /namdim/ & !< dimension namelist 1546 & cn_dimX, & !< x dimension name allowed 1547 & cn_dimY, & !< y dimension name allowed 1548 & cn_dimZ, & !< z dimension name allowed 1549 & cn_dimT !< t dimension name allowed 1550 1551 !---------------------------------------------------------------- 1552 1553 ! init 1554 cm_dimX(:)='' 1555 cm_dimY(:)='' 1556 cm_dimZ(:)='' 1557 cm_dimT(:)='' 1558 1559 ! read config variable file 1560 INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist) 1561 IF( ll_exist )THEN 1562 1563 il_fileid=fct_getunit() 1564 1565 OPEN( il_fileid, FILE=TRIM(cd_file), & 1566 & FORM='FORMATTED', & 1567 & ACCESS='SEQUENTIAL', & 1568 & STATUS='OLD', & 1569 & ACTION='READ', & 1570 & IOSTAT=il_status) 1571 CALL fct_err(il_status) 1572 IF( il_status /= 0 )THEN 1573 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_file)) 1574 ENDIF 1575 1576 READ( il_fileid, NML = namdim ) 1577 cm_dimX(:)=cn_dimX(:) 1578 cm_dimY(:)=cn_dimY(:) 1579 cm_dimZ(:)=cn_dimZ(:) 1580 cm_dimT(:)=cn_dimT(:) 1581 1582 CLOSE( il_fileid ) 1583 1584 ELSE 1585 1586 CALL logger_fatal("DIM DEF EXTRA: can't find configuration"//& 1587 & " file "//TRIM(cd_file)) 1588 1589 ENDIF 1590 1591 END SUBROUTINE dim_def_extra 1592 !------------------------------------------------------------------- 1593 !> @brief This function check if dimension is allowed, i.e defined 1594 !> in dimension configuraton file 1595 !> 1596 !> @author J.Paul 1597 !> @date OCTOber, 2016 - Initial Version 1598 ! 1599 !> @param[in] cd_name dimension name 1600 !> @param[in] cd_dim array dimension name allowed 1601 !> @return true if dimension is allowed 1602 !------------------------------------------------------------------- 1603 FUNCTION dim__is_allowed(cd_name, cd_dim) 1604 IMPLICIT NONE 1605 1606 ! Argument 1607 CHARACTER(LEN=*), INTENT(IN) :: cd_name 1608 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim 1609 1610 ! function 1611 LOGICAL :: dim__is_allowed 1612 1613 ! loop indices 1614 INTEGER(i4) :: ji 1615 !---------------------------------------------------------------- 1616 1617 dim__is_allowed=.FALSE. 1618 ji=1 1619 DO WHILE( TRIM(cd_dim(ji)) /= '' ) 1620 IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN 1621 dim__is_allowed=.TRUE. 1622 EXIT 1623 ENDIF 1624 ji=ji+1 1625 ENDDO 1626 1627 END FUNCTION dim__is_allowed 1628 1503 1629 END MODULE dim 1504 1630 -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md
r7026 r7153 7 7 ## New Features 8 8 - create_meshmask.f90 program to create meshmask from coordinates and bathymetry files. 9 - create_meshmask.f90 allows to write domain_cfg file 9 10 - merge_bathy.f90: allow to choose the number of boundary point with coarse grid value. 11 - dimension.f90: dimension allowed read in configuration file. 10 12 ## Changes 11 13 - create_coord.f90: allow to define sub domain with coarse grid indices or coordinates. 12 14 - grid.f90:grid__get_closest_str: add function to get closest grid point using coarse grid coordinates strucutre. 13 - iom.f90:iom_open: open cdf4 file as cdf 15 - iom_cdf.f90:iom_cdf__get_info: define cdf4 as cdf 16 - variable.f90: add subroutine to clean global array of extra information, and define logical for variable to be used. 17 - create_coord.f90: dimension to be used select from configuration file 18 - create_bathy.f90: dimension to be used select from configuration file 19 - merge_bathy.f90: dimension to be used select from configuration file 20 - create_boundary.f90: dimension to be used select from configuration file 21 - create_restart.f90: dimension to be used select from configuration file 14 22 ## Bug fixes 15 23 - boundary.f90:boundary_check: take into account that boundaries are compute on T point, but expressed on U,V point 24 - grid.f90:grid__get_closest_str: use max of zero and east-west overlap instead of east-west overlap 16 25 17 26 # Initial Release 2016-03-17 -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/global.f90
r7025 r7153 67 67 68 68 INTEGER(i4) , PARAMETER :: ip_maxvar =200 !< maximum number of variable 69 INTEGER(i4) , PARAMETER :: ip_maxmtx = 100!< matrix variable maximum dimension (cf create_bathy)70 INTEGER(i4) , PARAMETER :: ip_maxseg = 50 !< maximum number of segment for each boundary69 INTEGER(i4) , PARAMETER :: ip_maxmtx =50 !< matrix variable maximum dimension (cf create_bathy) 70 INTEGER(i4) , PARAMETER :: ip_maxseg =10 !< maximum number of segment for each boundary 71 71 72 72 INTEGER(i4) , PARAMETER :: ip_nsep=2 !< number of separator listed … … 112 112 113 113 114 INTEGER(i4) , PARAMETER :: ip_maxdimcfg=10 !< maximum allowed dimension in configuration file 114 115 INTEGER(i4) , PARAMETER :: ip_maxdim=4 115 116 INTEGER(i4) , PARAMETER :: jp_I=1 … … 131 132 INTEGER(i4), PARAMETER :: jp_west =4 132 133 133 INTEGER(i4) , PARAMETER :: ip_maxdum = 10 !< maximum dummy variable, dimension, attribute 134 INTEGER(i4) , PARAMETER :: ip_maxdumcfg = 10 !< maximum dummy variable, dimension, or attribute 135 !< in configuration file 134 136 135 137 END MODULE global -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid.f90
r7025 r7153 478 478 !------------------------------------------------------------------- 479 479 !> @brief This subroutine get information about global domain, given mpp 480 !> struc utre.480 !> structure. 481 481 !> 482 482 !> @details … … 547 547 548 548 SELECT CASE(il_perio) 549 CASE(3,4)550 il_pivot=1551 CASE(5,6)552 il_pivot=0553 CASE(0,1,2)554 il_pivot=1549 CASE(3,4) 550 il_pivot=1 551 CASE(5,6) 552 il_pivot=0 553 CASE(0,1,2) 554 il_pivot=1 555 555 END SELECT 556 556 … … 1668 1668 !> else return the size of the ovarlap band. 1669 1669 !> East-West overlap is computed comparing longitude value of the 1670 !> South "part of the domain, to avoid north fold boundary.1670 !> South part of the domain, to avoid north fold boundary. 1671 1671 !> 1672 1672 ! … … 1675 1675 !> @date October, 2014 1676 1676 !> - work on mpp file structure instead of file structure 1677 !> @date October, 2016 1678 !> - check longitude as longname 1677 1679 !> 1678 1680 !> @param[in] td_lon longitude variable structure … … 1724 1726 ALLOCATE( dl_vare(il_jmax-il_jmin+1) ) 1725 1727 ALLOCATE( dl_varw(il_jmax-il_jmin+1) ) 1726 1728 1727 1729 dl_vare(:)=dl_value(il_east,il_jmin:il_jmax) 1728 1730 dl_varw(:)=dl_value(il_west,il_jmin:il_jmax) 1729 1730 IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. & 1731 & ALL(dl_varw(:)==td_var%d_fill) ) )THEN 1732 1733 IF( TRIM(td_var%c_stdname) == 'longitude' )THEN 1731 1732 IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. & 1733 & ALL(dl_varw(:)==td_var%d_fill) ) )THEN 1734 1735 IF( TRIM(td_var%c_stdname) == 'longitude' .OR. & 1736 & SCAN(TRIM(td_var%c_longname), 'longitude') == 0 )THEN 1734 1737 WHERE( dl_value(:,:) > 180._dp .AND. & 1735 1738 & dl_value(:,:) /= td_var%d_fill ) … … 1755 1758 ELSE 1756 1759 dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax) 1757 1760 1758 1761 IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN 1759 1762 grid__get_ew_overlap_var=ji+1 … … 1781 1784 !> else return the size of the ovarlap band. 1782 1785 !> East-West overlap is computed comparing longitude value of the 1783 !> South "part of the domain, to avoid north fold boundary.1786 !> South part of the domain, to avoid north fold boundary. 1784 1787 !> 1785 1788 !> @author J.Paul 1786 1789 !> @date October, 2014 - Initial Version 1790 !> @date October, 2016 1791 !> - check varid for longitude_T 1787 1792 !> 1788 1793 !> @param[in] td_file file structure … … 1805 1810 !---------------------------------------------------------------- 1806 1811 1807 il_varid=var_get_i ndex(td_file%t_var(:), 'longitude')1812 il_varid=var_get_id(td_file%t_var(:), 'longitude', 'longitude_T') 1808 1813 IF( il_varid /= 0 )THEN 1809 1814 ! read longitude on boundary 1810 tl_var=iom_read_var(td_file, 'longitude')1815 tl_var=iom_read_var(td_file, il_varid) 1811 1816 ELSE 1812 1817 DO ji=1,td_file%i_nvar … … 1831 1836 !> else return the size of the ovarlap band. 1832 1837 !> East-West overlap is computed comparing longitude value of the 1833 !> South "part of the domain, to avoid north fold boundary.1838 !> South part of the domain, to avoid north fold boundary. 1834 1839 !> 1835 1840 ! … … 1838 1843 !> @date October, 2014 1839 1844 !> - work on mpp file structure instead of file structure 1845 !> @date October, 2016 1846 !> - check varid for longitude_T 1840 1847 !> 1841 1848 !> @param[in] td_mpp mpp structure … … 1862 1869 1863 1870 ! read longitude on boundary 1864 il_varid=var_get_i ndex(td_mpp%t_proc(1)%t_var(:),'longitude')1871 il_varid=var_get_id(td_mpp%t_proc(1)%t_var(:),'longitude', 'longitude_T') 1865 1872 IF( il_varid /= 0 )THEN 1866 tl_var=iom_mpp_read_var(td_mpp, 'longitude')1873 tl_var=iom_mpp_read_var(td_mpp, il_varid) 1867 1874 ELSE 1868 1875 DO ji=1,td_mpp%t_proc(1)%i_nvar … … 1878 1885 grid__get_ew_overlap_mpp=il_ew 1879 1886 ENDIF 1880 1881 1887 1882 1888 ! clean … … 3033 3039 !> @author J.Paul 3034 3040 !> @date April, 2016 - Initial Version 3035 ! 3041 !> @date October, 2016 3042 !> - use max of zero and east-west overlap instead of east-west overlap 3043 !> 3036 3044 !> @param[in] td_coord0 coarse grid coordinate mpp structure 3037 3045 !> @param[in] dd_lon1 fine grid longitude … … 3060 3068 3061 3069 INTEGER(i4) :: il_ind 3070 INTEGER(i4) :: il_ew 3062 3071 3063 3072 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 … … 3109 3118 CALL iom_mpp_close(tl_coord0) 3110 3119 3111 ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-tl_coord0%i_ew, & 3120 il_ew=MAX(0,tl_coord0%i_ew) 3121 ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-il_ew, & 3112 3122 & tl_coord0%t_dim(jp_J)%i_len) ) 3113 ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len- tl_coord0%i_ew, &3123 ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len-il_ew, & 3114 3124 & tl_coord0%t_dim(jp_J)%i_len) ) 3115 3125 3116 dl_lon0(:,:)=tl_lon0%d_value( tl_coord0%i_ew+1:,:,1,1)3117 dl_lat0(:,:)=tl_lat0%d_value( tl_coord0%i_ew+1:,:,1,1)3126 dl_lon0(:,:)=tl_lon0%d_value(il_ew+1:,:,1,1) 3127 dl_lat0(:,:)=tl_lat0%d_value(il_ew+1:,:,1,1) 3118 3128 3119 3129 id_res(:)=grid_get_closest( dl_lon0, dl_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) … … 3602 3612 ENDIF 3603 3613 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3604 3614 3605 3615 ! close mpp files 3606 3616 CALL iom_mpp_close(tl_coord0) -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid_hgr.f90
r7025 r7153 85 85 !> @date September, 2015 86 86 !> - J, Paul : rewrite to SIREN format from $Id: domhgr.F90 5506 2015-06-29 15:19:38Z clevy $ 87 !> @date October, 201 587 !> @date October, 2016 88 88 !> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 89 !> - J, Paul : compute coriolis factor at f-point and at t-point 90 !> - J, Paul : do not use anymore special case for ORCA grid 89 91 !> 90 92 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 146 148 PUBLIC :: tg_e2f 147 149 148 PUBLIC :: tg_ff 150 PUBLIC :: tg_ff_t 151 PUBLIC :: tg_ff_f 149 152 150 153 PUBLIC :: tg_gcost … … 186 189 ! REAL(dp) :: d_ppe2_m 187 190 188 INTEGER(i4) :: i_cla191 ! INTEGER(i4) :: i_cla 189 192 190 CHARACTER(LEN=lc) :: c_cfg193 ! CHARACTER(LEN=lc) :: c_cfg 191 194 INTEGER(i4) :: i_cfg 192 INTEGER(i4) :: i_bench195 LOGICAL :: l_bench 193 196 194 197 END TYPE … … 227 230 TYPE(TVAR), SAVE :: tg_e2f 228 231 229 TYPE(TVAR), SAVE :: tg_ff 232 TYPE(TVAR), SAVE :: tg_ff_t 233 TYPE(TVAR), SAVE :: tg_ff_f 230 234 231 235 TYPE(TVAR), SAVE :: tg_gcost … … 249 253 !> @param[in] jpj 250 254 !------------------------------------------------------------------- 251 SUBROUTINE grid_hgr_init(jpi,jpj,jpk )255 SUBROUTINE grid_hgr_init(jpi,jpj,jpk,ld_domcfg) 252 256 IMPLICIT NONE 253 257 ! Argument … … 255 259 INTEGER(i4), INTENT(IN) :: jpj 256 260 INTEGER(i4), INTENT(IN) :: jpk 261 LOGICAL , INTENT(IN) :: ld_domcfg 257 262 258 263 REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp2D … … 292 297 tg_e2f = var_init('e2f' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 293 298 294 tg_ff = var_init('ff' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 295 296 tg_gcost =var_init('gcost',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 297 tg_gcosu =var_init('gcosu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 298 tg_gcosv =var_init('gcosv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 299 tg_gcosf =var_init('gcosf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 300 301 tg_gsint =var_init('gsint',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 302 tg_gsinu =var_init('gsinu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 303 tg_gsinv =var_init('gsinv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 304 tg_gsinf =var_init('gsinf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 299 tg_ff_t = var_init('ff_t' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 300 tg_ff_f = var_init('ff_f' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 301 302 IF( .NOT. ld_domcfg )THEN 303 tg_gcost =var_init('gcost',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 304 tg_gcosu =var_init('gcosu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 305 tg_gcosv =var_init('gcosv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 306 tg_gcosf =var_init('gcosf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 307 308 tg_gsint =var_init('gsint',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 309 tg_gsinu =var_init('gsinu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 310 tg_gsinv =var_init('gsinv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 311 tg_gsinf =var_init('gsinf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 312 ENDIF 305 313 306 314 ! variable 3D … … 308 316 309 317 tg_tmask = var_init('tmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 310 tg_umask = var_init('umask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 311 tg_vmask = var_init('vmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 312 tg_fmask = var_init('fmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 318 IF( .NOT. ld_domcfg )THEN 319 tg_umask = var_init('umask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 320 tg_vmask = var_init('vmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 321 tg_fmask = var_init('fmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 322 ENDIF 313 323 314 324 ! tg_wmask = var_init('wmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) … … 324 334 !> 325 335 !------------------------------------------------------------------- 326 SUBROUTINE grid_hgr_clean( )336 SUBROUTINE grid_hgr_clean(ld_domcfg) 327 337 IMPLICIT NONE 328 338 ! Argument 339 LOGICAL , INTENT(IN) :: ld_domcfg 329 340 330 341 ! local variable … … 332 343 !---------------------------------------------------------------- 333 344 CALL var_clean(tg_ssmask ) 334 CALL var_clean(tg_tmask )335 CALL var_clean(tg_umask )336 CALL var_clean(tg_vmask )337 CALL var_clean(tg_fmask )338 345 339 346 CALL var_clean(tg_glamt) … … 357 364 CALL var_clean(tg_e2f ) 358 365 359 CALL var_clean(tg_ff ) 360 361 CALL var_clean(tg_gcost ) 362 CALL var_clean(tg_gcosu ) 363 CALL var_clean(tg_gcosv ) 364 CALL var_clean(tg_gcosf ) 365 366 CALL var_clean(tg_gsint ) 367 CALL var_clean(tg_gsinu ) 368 CALL var_clean(tg_gsinv ) 369 CALL var_clean(tg_gsinf ) 370 366 CALL var_clean(tg_ff_t ) 367 CALL var_clean(tg_ff_f ) 368 369 IF( .NOT. ld_domcfg )THEN 370 CALL var_clean(tg_gcost ) 371 CALL var_clean(tg_gcosu ) 372 CALL var_clean(tg_gcosv ) 373 CALL var_clean(tg_gcosf ) 374 375 CALL var_clean(tg_gsint ) 376 CALL var_clean(tg_gsinu ) 377 CALL var_clean(tg_gsinv ) 378 CALL var_clean(tg_gsinf ) 379 ENDIF 380 381 CALL var_clean(tg_tmask ) 382 IF( .NOT. ld_domcfg )THEN 383 CALL var_clean(tg_umask ) 384 CALL var_clean(tg_vmask ) 385 CALL var_clean(tg_fmask ) 386 ENDIF 371 387 END SUBROUTINE grid_hgr_clean 372 388 !------------------------------------------------------------------- … … 409 425 ! REAL(dp) :: dn_ppe2_m = NF90_FILL_DOUBLE 410 426 411 ! namcla412 INTEGER(i4) :: in_cla = 0427 ! ! namcla 428 ! INTEGER(i4) :: in_cla = 0 413 429 414 430 ! namgrd 415 CHARACTER(LEN=lc) :: cn_cfg = ''431 ! CHARACTER(LEN=lc) :: cn_cfg = '' 416 432 INTEGER(i4) :: in_cfg = 0 417 INTEGER(i4) :: in_bench = 0433 LOGICAL :: ln_bench = .FALSE. 418 434 419 435 !---------------------------------------------------------------- … … 433 449 ! & dn_ppe2_m !< meridional grid-spacing (degrees) 434 450 435 NAMELIST /namcla/ &436 & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2)451 ! NAMELIST /namcla/ & 452 ! & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2) 437 453 438 454 NAMELIST/namgrd/ & !< orca grid namelist 439 & cn_cfg, & !< name of the configuration (orca)455 ! & cn_cfg, & !< name of the configuration (orca) 440 456 & in_cfg, & !< resolution of the configuration (2,1,025..) 441 & in_bench !< benchmark parameter (in_mshhgr = 5 ).457 & ln_bench !< benchmark parameter (in_mshhgr = 5 ). 442 458 443 459 !---------------------------------------------------------------- … … 461 477 462 478 READ( il_fileid, NML = namhgr ) 463 READ( il_fileid, NML = namcla )464 READ( il_fileid, NML = namgrd )479 ! READ( il_fileid, NML = namcla ) 480 ! READ( il_fileid, NML = namgrd ) 465 481 466 482 CLOSE( il_fileid, IOSTAT=il_status ) … … 482 498 ! grid_hgr_nam%d_ppe2_m = dn_ppe2_m 483 499 484 grid_hgr_nam%i_cla = in_cla485 486 grid_hgr_nam%c_cfg = TRIM(cn_cfg)500 ! grid_hgr_nam%i_cla = in_cla 501 502 ! grid_hgr_nam%c_cfg = TRIM(cn_cfg) 487 503 grid_hgr_nam%i_cfg = in_cfg 488 grid_hgr_nam% i_bench = in_bench504 grid_hgr_nam%l_bench = ln_bench 489 505 490 506 ELSE … … 505 521 !> @param[in] jpj 506 522 !------------------------------------------------------------------- 507 SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj )523 SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj,ld_domcfg) 508 524 IMPLICIT NONE 509 525 ! Argument … … 511 527 INTEGER(i4), INTENT(IN) :: jpi 512 528 INTEGER(i4), INTENT(IN) :: jpj 529 LOGICAL , INTENT(IN) :: ld_domcfg 513 530 514 531 ! local variable … … 516 533 ! loop indices 517 534 !---------------------------------------------------------------- 518 CALL logger_info('GRI GHGR FILL : define the horizontal mesh from ithe'//&535 CALL logger_info('GRID HGR FILL : define the horizontal mesh from ithe'//& 519 536 & ' type of horizontal mesh mshhgr = '//TRIM(fct_str(td_nam%i_mshhgr))) 520 537 IF( td_nam%i_mshhgr == 1 )THEN … … 538 555 CASE(0) ! curvilinear coordinate on the sphere read in coordinate.nc file 539 556 540 CALL grid_hgr__fill_curv(td_nam ,jpi,jpj)557 CALL grid_hgr__fill_curv(td_nam)!,jpi,jpj) 541 558 542 559 CASE(1) ! geographical mesh on the sphere with regular grid-spacing … … 558 575 CASE DEFAULT 559 576 560 CALL logger_fatal('GRI GHGR FILL : bad flag value for mshhgr = '//&577 CALL logger_fatal('GRID HGR FILL : bad flag value for mshhgr = '//& 561 578 & TRIM(fct_str(td_nam%i_mshhgr))) 562 579 … … 567 584 568 585 ! create coriolis factor 569 CALL grid_hgr__fill_coriolis(td_nam,jpi ,jpj)586 CALL grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 570 587 571 588 ! Control of domain for symetrical condition … … 582 599 ! compute angles between model grid lines and the North direction 583 600 ! --------------------------------------------------------------- 584 CALL grid_hgr__angle(td_nam,jpi,jpj) 601 IF( .NOT. ld_domcfg )THEN 602 CALL grid_hgr__angle(td_nam,jpi,jpj) 603 ENDIF 585 604 586 605 END SUBROUTINE grid_hgr_fill … … 591 610 !> @author J.Paul 592 611 !> @date September, 2015 - Initial version 612 !> @date October, 2016 613 !> - do not use anymore special case for ORCA grid 593 614 !> 594 615 !> @param[in] td_nam 595 ! >@param[in] jpi596 ! >@param[in] jpj597 !------------------------------------------------------------------- 598 SUBROUTINE grid_hgr__fill_curv( td_nam ,jpi,jpj )616 ! @param[in] jpi 617 ! @param[in] jpj 618 !------------------------------------------------------------------- 619 SUBROUTINE grid_hgr__fill_curv( td_nam )!,jpi,jpj ) 599 620 IMPLICIT NONE 600 621 ! Argument 601 622 TYPE(TNAMH), INTENT(IN) :: td_nam 602 INTEGER(i4), INTENT(IN) :: jpi603 INTEGER(i4), INTENT(IN) :: jpj623 ! INTEGER(i4), INTENT(IN) :: jpi 624 ! INTEGER(i4), INTENT(IN) :: jpj 604 625 605 626 ! local variable 606 INTEGER(i4) :: ii0, ii1, ij0, ij1 ! temporary integers607 INTEGER(i4) :: isrow ! index for ORCA1 starting row627 ! INTEGER(i4) :: ii0, ii1, ij0, ij1 ! temporary integers 628 ! INTEGER(i4) :: isrow ! index for ORCA1 starting row 608 629 609 630 TYPE(TMPP) :: tl_coord … … 662 683 !! WARNING extended grid have to be correctly fill 663 684 664 !! special case for ORCA grid665 ! ORCA R2 configuration666 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN667 IF( td_nam%i_cla == 0 ) THEN668 !669 ! Gibraltar Strait (e2u = 20 km)670 ii0 = 139 ; ii1 = 140671 ij0 = 102 ; ij1 = 102672 ! e2u = 20 km673 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3674 CALL logger_info('orca_r2: Gibraltar : e2u reduced to 20 km')675 !676 ! Bab el Mandeb (e2u = 18 km)677 ii0 = 160 ; ii1 = 160678 ij0 = 88 ; ij1 = 88679 ! e1v = 18 km680 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 18.e3681 ! e2u = 30 km682 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3683 684 CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km')685 CALL logger_info('e1v reduced to 18 km')686 ENDIF687 ! Danish Straits688 ii0 = 145 ; ii1 = 146689 ij0 = 116 ; ij1 = 116690 ! e2u = 10 km691 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3692 CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km')693 ENDIF694 695 ! ORCA R1 configuration696 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN697 ! This dirty section will be suppressed by simplification process: all this will come back in input files698 ! Currently these hard-wired indices relate to configuration with699 ! extend grid (jpjglo=332)700 ! which had a grid-size of 362x292.701 702 isrow = 332 - jpj703 704 ! Gibraltar Strait (e2u = 20 km)705 ii0 = 282 ; ii1 = 283706 ij0 = 201 + isrow ; ij1 = 241 - isrow707 ! e2u = 20 km708 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3709 CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km')710 711 ! Bhosporus Strait (e2u = 10 km)712 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km)713 ij0 = 208 + isrow ; ij1 = 248 - isrow714 ! Bhosporus Strait (e2u = 10 km)715 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3716 CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km')717 718 ! Lombok Strait (e1v = 13 km)719 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km)720 ij0 = 124 + isrow ; ij1 = 165 - isrow721 ! Lombok Strait (e1v = 13 km)722 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3723 CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km')724 725 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]726 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]727 ij0 = 124 + isrow ; ij1 = 165 - isrow728 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]729 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 8.e3730 CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km')731 732 ! Ombai Strait (e1v = 13 km)733 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km)734 ij0 = 124 + isrow ; ij1 = 165 - isrow735 ! Ombai Strait (e1v = 13 km)736 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3737 CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km')738 739 ! Timor Passage (e1v = 20 km)740 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km)741 ij0 = 124 + isrow ; ij1 = 145 - isrow742 ! Timor Passage (e1v = 20 km)743 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3744 CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km')745 746 ! West Halmahera Strait (e1v = 30 km)747 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km)748 ij0 = 141 + isrow ; ij1 = 182 - isrow749 ! West Halmahera Strait (e1v = 30 km)750 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3751 CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km')752 753 ! East Halmahera Strait (e1v = 50 km)754 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km)755 ij0 = 141 + isrow ; ij1 = 182 - isrow756 ! East Halmahera Strait (e1v = 50 km)757 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3758 CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km')759 760 ENDIF761 762 ! ORCA R05 configuration763 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN764 765 ! Gibraltar Strait (e2u = 20 km)766 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km)767 ij0 = 327 ; ij1 = 327768 ! Gibraltar Strait (e2u = 20 km)769 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3770 CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait')771 !772 ! Bosphore Strait (e2u = 10 km)773 ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u = 10 km)774 ij0 = 343 ; ij1 = 343775 ! Bosphore Strait (e2u = 10 km)776 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3777 CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait')778 !779 ! Sumba Strait (e2u = 40 km)780 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u = 40 km)781 ij0 = 232 ; ij1 = 232782 ! Sumba Strait (e2u = 40 km)783 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 40.e3784 CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait')785 !786 ! Ombai Strait (e2u = 15 km)787 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u = 15 km)788 ij0 = 232 ; ij1 = 232789 ! Ombai Strait (e2u = 15 km)790 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 15.e3791 CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait')792 !793 ! Palk Strait (e2u = 10 km)794 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u = 10 km)795 ij0 = 270 ; ij1 = 270796 ! Palk Strait (e2u = 10 km)797 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3798 CALL logger_info('orca_r05: Reduced e2u at the Palk Strait')799 !800 ! Lombok Strait (e1v = 10 km)801 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v = 10 km)802 ij0 = 232 ; ij1 = 233803 ! Lombok Strait (e1v = 10 km)804 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3805 CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait')806 !807 !808 ! Bab el Mandeb (e1v = 25 km)809 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v = 25 km)810 ij0 = 276 ; ij1 = 276811 ! Bab el Mandeb (e1v = 25 km)812 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 25.e3813 CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb')814 815 ENDIF685 ! !! special case for ORCA grid 686 ! ! ORCA R2 configuration 687 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN 688 ! IF( td_nam%i_cla == 0 ) THEN 689 ! ! 690 ! ! Gibraltar Strait (e2u = 20 km) 691 ! ii0 = 139 ; ii1 = 140 692 ! ij0 = 102 ; ij1 = 102 693 ! ! e2u = 20 km 694 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 695 ! CALL logger_info('orca_r2: Gibraltar : e2u reduced to 20 km') 696 ! ! 697 ! ! Bab el Mandeb (e2u = 18 km) 698 ! ii0 = 160 ; ii1 = 160 699 ! ij0 = 88 ; ij1 = 88 700 ! ! e1v = 18 km 701 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 18.e3 702 ! ! e2u = 30 km 703 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3 704 ! 705 ! CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km') 706 ! CALL logger_info('e1v reduced to 18 km') 707 ! ENDIF 708 ! ! Danish Straits 709 ! ii0 = 145 ; ii1 = 146 710 ! ij0 = 116 ; ij1 = 116 711 ! ! e2u = 10 km 712 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 713 ! CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km') 714 ! ENDIF 715 ! 716 ! ! ORCA R1 configuration 717 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN 718 ! ! This dirty section will be suppressed by simplification process: all this will come back in input files 719 ! ! Currently these hard-wired indices relate to configuration with 720 ! ! extend grid (jpjglo=332) 721 ! ! which had a grid-size of 362x292. 722 ! 723 ! isrow = 332 - jpj 724 ! 725 ! ! Gibraltar Strait (e2u = 20 km) 726 ! ii0 = 282 ; ii1 = 283 727 ! ij0 = 201 + isrow ; ij1 = 241 - isrow 728 ! ! e2u = 20 km 729 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 730 ! CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km') 731 ! 732 ! ! Bhosporus Strait (e2u = 10 km) 733 ! ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km) 734 ! ij0 = 208 + isrow ; ij1 = 248 - isrow 735 ! ! Bhosporus Strait (e2u = 10 km) 736 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 737 ! CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km') 738 ! 739 ! ! Lombok Strait (e1v = 13 km) 740 ! ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km) 741 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 742 ! ! Lombok Strait (e1v = 13 km) 743 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3 744 ! CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km') 745 ! 746 ! ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 747 ! ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 748 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 749 ! ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 750 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 8.e3 751 ! CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km') 752 ! 753 ! ! Ombai Strait (e1v = 13 km) 754 ! ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km) 755 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 756 ! ! Ombai Strait (e1v = 13 km) 757 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3 758 ! CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km') 759 ! 760 ! ! Timor Passage (e1v = 20 km) 761 ! ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km) 762 ! ij0 = 124 + isrow ; ij1 = 145 - isrow 763 ! ! Timor Passage (e1v = 20 km) 764 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 765 ! CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km') 766 ! 767 ! ! West Halmahera Strait (e1v = 30 km) 768 ! ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km) 769 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 770 ! ! West Halmahera Strait (e1v = 30 km) 771 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3 772 ! CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km') 773 ! 774 ! ! East Halmahera Strait (e1v = 50 km) 775 ! ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km) 776 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 777 ! ! East Halmahera Strait (e1v = 50 km) 778 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3 779 ! CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km') 780 ! 781 ! ENDIF 782 ! 783 ! ! ORCA R05 configuration 784 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN 785 ! 786 ! ! Gibraltar Strait (e2u = 20 km) 787 ! ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km) 788 ! ij0 = 327 ; ij1 = 327 789 ! ! Gibraltar Strait (e2u = 20 km) 790 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 791 ! CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait') 792 ! ! 793 ! ! Bosphore Strait (e2u = 10 km) 794 ! ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u = 10 km) 795 ! ij0 = 343 ; ij1 = 343 796 ! ! Bosphore Strait (e2u = 10 km) 797 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 798 ! CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait') 799 ! ! 800 ! ! Sumba Strait (e2u = 40 km) 801 ! ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u = 40 km) 802 ! ij0 = 232 ; ij1 = 232 803 ! ! Sumba Strait (e2u = 40 km) 804 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 40.e3 805 ! CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait') 806 ! ! 807 ! ! Ombai Strait (e2u = 15 km) 808 ! ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u = 15 km) 809 ! ij0 = 232 ; ij1 = 232 810 ! ! Ombai Strait (e2u = 15 km) 811 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 15.e3 812 ! CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait') 813 ! ! 814 ! ! Palk Strait (e2u = 10 km) 815 ! ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u = 10 km) 816 ! ij0 = 270 ; ij1 = 270 817 ! ! Palk Strait (e2u = 10 km) 818 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 819 ! CALL logger_info('orca_r05: Reduced e2u at the Palk Strait') 820 ! ! 821 ! ! Lombok Strait (e1v = 10 km) 822 ! ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v = 10 km) 823 ! ij0 = 232 ; ij1 = 233 824 ! ! Lombok Strait (e1v = 10 km) 825 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 826 ! CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait') 827 ! ! 828 ! ! 829 ! ! Bab el Mandeb (e1v = 25 km) 830 ! ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v = 25 km) 831 ! ij0 = 276 ; ij1 = 276 832 ! ! Bab el Mandeb (e1v = 25 km) 833 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 25.e3 834 ! CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb') 835 ! 836 ! ENDIF 816 837 817 838 END SUBROUTINE grid_hgr__fill_curv … … 1071 1092 ze1 = 106000. / FLOAT(td_nam%i_cfg) 1072 1093 ! benchmark: forced the resolution to be about 100 km 1073 IF( td_nam% i_bench /= 0) ze1 = 106000.e01094 IF( td_nam%l_bench ) ze1 = 106000.e0 1074 1095 zsin_alpha = - SQRT( 2. ) / 2. 1075 1096 zcos_alpha = SQRT( 2. ) / 2. 1076 1097 ze1deg = ze1 / (dp_rearth * dp_deg2rad) 1077 ! benchmark: keep the lat/+lon at the right in_cfg resolution1078 IF( td_nam%i_bench /= 0 ) ze1deg = ze1deg / FLOAT(td_nam%i_cfg)1079 1098 dl_glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpj-2 ) 1080 1099 dl_gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpj-2 ) … … 1134 1153 !> @author J.Paul 1135 1154 !> @date September, 2015 - Initial version 1155 !> @date October, 2016 1156 !> - compute coriolis factor at f-point and at t-point 1136 1157 !> 1137 1158 !> @param[in] td_nam 1138 1159 !> @param[in] jpi 1139 ! >@param[in] jpj1140 !------------------------------------------------------------------- 1141 SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi ,jpj)1160 ! @param[in] jpj 1161 !------------------------------------------------------------------- 1162 SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 1142 1163 IMPLICIT NONE 1143 1164 ! Argument 1144 1165 TYPE(TNAMH), INTENT(IN) :: td_nam 1145 1166 INTEGER(i4), INTENT(IN) :: jpi 1146 INTEGER(i4), INTENT(IN) :: jpj1167 ! INTEGER(i4), INTENT(IN) :: jpj 1147 1168 1148 1169 ! local variable … … 1159 1180 CASE ( 0, 1, 4 ) ! mesh on the sphere 1160 1181 1161 tg_ff%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1)) 1182 tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1)) 1183 tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphit%d_value(:,:,1,1)) ! at t-point 1162 1184 1163 1185 CASE ( 2 ) ! f-plane at ppgphi0 1164 1186 1165 tg_ff%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1187 tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1188 tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1166 1189 CALL logger_info('f-plane: Coriolis parameter = constant = '//& 1167 & TRIM(fct_str(tg_ff %d_value(1,1,1,1))) )1190 & TRIM(fct_str(tg_ff_f%d_value(1,1,1,1))) ) 1168 1191 1169 1192 CASE ( 3 ) ! beta-plane … … 1178 1201 zf0 = 2. * dp_omega * SIN( dp_deg2rad * zphi0 ) 1179 1202 ! f = f0 +beta* y ( y=0 at south) 1180 tg_ff%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3 1203 tg_ff_f%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3 1204 tg_ff_t%d_value(:,:,1,1) = zf0 + zbeta * tg_gphit%d_value(:,:,1,1) * 1.e3 1181 1205 1182 1206 CASE ( 5 ) ! beta-plane and rotated domain (gyre configuration) … … 1190 1214 1191 1215 ! f = f0 +beta* y ( y=0 at south) 1192 tg_ff%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) * dp_deg2rad * dp_rearth ) 1216 tg_ff_f%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) & 1217 & * dp_deg2rad * dp_rearth ) 1218 tg_ff_t%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphit%d_value(:,:,1,1) - zphi0 ) & 1219 & * dp_deg2rad * dp_rearth ) 1193 1220 1194 1221 END SELECT -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid_zgr.f90
r7025 r7153 53 53 !> - H. Liu : Modifications for Wetting/Drying 54 54 !> @date October, 2016 55 !> - update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 55 !> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 56 !> - J, Paul : do not use anymore special case for ORCA grid. 56 57 !> 57 58 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 136 137 PRIVATE :: grid_zgr__bat 137 138 PRIVATE :: grid_zgr__zco 138 PRIVATE :: grid_zgr__bat_zoom139 ! PRIVATE :: grid_zgr__bat_zoom 139 140 PRIVATE :: grid_zgr__bat_ctl 140 141 PRIVATE :: grid_zgr__bot_level … … 208 209 REAL(dp) :: d_wdld 209 210 210 CHARACTER(LEN=lc) :: c_cfg211 INTEGER(i4) :: i_cfg212 INTEGER(i4) :: i_bench213 LOGICAL :: l_zoom211 ! CHARACTER(LEN=lc) :: c_cfg 212 ! INTEGER(i4) :: i_cfg 213 ! INTEGER(i4) :: i_bench 214 ! LOGICAL :: l_zoom 214 215 LOGICAL :: l_c1d 215 216 216 CHARACTER(LEN=lc) :: c_cfz217 INTEGER(i4) :: i_izoom218 INTEGER(i4) :: i_jzoom219 LOGICAL :: l_zoom_s220 LOGICAL :: l_zoom_e221 LOGICAL :: l_zoom_w222 LOGICAL :: l_zoom_n217 ! CHARACTER(LEN=lc) :: c_cfz 218 ! INTEGER(i4) :: i_izoom 219 ! INTEGER(i4) :: i_jzoom 220 ! LOGICAL :: l_zoom_s 221 ! LOGICAL :: l_zoom_e 222 ! LOGICAL :: l_zoom_w 223 ! LOGICAL :: l_zoom_n 223 224 224 225 END TYPE … … 277 278 !> @param[in] jpj 278 279 !> @param[in] jpk 280 !> @param[in] ld_sco 279 281 !------------------------------------------------------------------- 280 SUBROUTINE grid_zgr_init( jpi,jpj,jpk )282 SUBROUTINE grid_zgr_init( jpi,jpj,jpk, ld_sco ) 281 283 IMPLICIT NONE 282 284 ! Argument … … 284 286 INTEGER(i4), INTENT(IN) :: jpj 285 287 INTEGER(i4), INTENT(IN) :: jpk 288 LOGICAL , INTENT(IN) :: ld_sco 286 289 287 290 ! local variable … … 300 303 tg_e3t_1d =var_init('e3t_1d ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 301 304 302 tg_gsigt =var_init('gsigt ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 303 tg_gsigw =var_init('gsigw ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 304 tg_gsi3w =var_init('gsi3w ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 305 tg_esigt =var_init('esigt ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 306 tg_esigw =var_init('esigw ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 305 !only sco 306 IF( ld_sco )THEN 307 tg_gsigt =var_init('gsigt ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 308 tg_gsigw =var_init('gsigw ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 309 tg_gsi3w =var_init('gsi3w ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 310 tg_esigt =var_init('esigt ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 311 tg_esigw =var_init('esigw ',dl_tmp1D(:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 312 ENDIF 307 313 308 314 ! variable 2D … … 322 328 dl_tmp2D(:,:) =dp_fill 323 329 324 tg_hbatt =var_init('hbatt ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 325 tg_hbatu =var_init('hbatu ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 326 tg_hbatv =var_init('hbatv ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 327 tg_hbatf =var_init('hbatf ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 330 ! only sco 331 IF( ld_sco )THEN 332 tg_hbatt =var_init('hbatt ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 333 tg_hbatu =var_init('hbatu ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 334 tg_hbatv =var_init('hbatv ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 335 tg_hbatf =var_init('hbatf ',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 336 ENDIF 328 337 329 338 ! variable 3D … … 351 360 !> @date September, 2015 - Initial version 352 361 !> 362 !> @param[in] ld_sco 353 363 !------------------------------------------------------------------- 354 SUBROUTINE grid_zgr_clean( )364 SUBROUTINE grid_zgr_clean(ld_sco) 355 365 IMPLICIT NONE 356 366 ! Argument 367 LOGICAL , INTENT(IN) :: ld_sco 357 368 358 369 ! local variable … … 365 376 CALL var_clean(tg_e3t_1d ) 366 377 367 CALL var_clean(tg_gsigt ) 368 CALL var_clean(tg_gsigw ) 369 CALL var_clean(tg_gsi3w ) 370 CALL var_clean(tg_esigt ) 371 CALL var_clean(tg_esigw ) 378 IF( ld_sco )THEN 379 CALL var_clean(tg_gsigt ) 380 CALL var_clean(tg_gsigw ) 381 CALL var_clean(tg_gsi3w ) 382 CALL var_clean(tg_esigt ) 383 CALL var_clean(tg_esigw ) 384 ENDIF 372 385 373 386 CALL var_clean(tg_mbathy ) … … 382 395 !CALL var_clean(tg_mikf ) 383 396 384 CALL var_clean(tg_hbatt ) 385 CALL var_clean(tg_hbatu ) 386 CALL var_clean(tg_hbatv ) 387 CALL var_clean(tg_hbatf ) 397 IF( ld_sco )THEN 398 CALL var_clean(tg_hbatt ) 399 CALL var_clean(tg_hbatu ) 400 CALL var_clean(tg_hbatv ) 401 CALL var_clean(tg_hbatf ) 402 ENDIF 388 403 389 404 CALL var_clean(tg_gdept_0 ) … … 487 502 488 503 ! namgrd 489 CHARACTER(LEN=lc) :: cn_cfg = ''490 INTEGER(i4) :: in_cfg = 0491 INTEGER(i4) :: in_bench = 0492 LOGICAL :: ln_zoom = .FALSE.504 ! CHARACTER(LEN=lc) :: cn_cfg = '' 505 ! INTEGER(i4) :: in_cfg = 0 506 ! INTEGER(i4) :: in_bench = 0 507 ! LOGICAL :: ln_zoom = .FALSE. 493 508 LOGICAL :: ln_c1d = .FALSE. 494 509 495 ! namzoom496 CHARACTER(LEN=lc) :: cn_cfz =''497 INTEGER(i4) :: in_izoom = NF90_FILL_INT498 INTEGER(i4) :: in_jzoom = NF90_FILL_INT499 LOGICAL :: ln_zoom_s = .FALSE.500 LOGICAL :: ln_zoom_e = .FALSE.501 LOGICAL :: ln_zoom_w = .FALSE.502 LOGICAL :: ln_zoom_n = .FALSE.510 ! ! namzoom 511 ! CHARACTER(LEN=lc) :: cn_cfz ='' 512 ! INTEGER(i4) :: in_izoom = NF90_FILL_INT 513 ! INTEGER(i4) :: in_jzoom = NF90_FILL_INT 514 ! LOGICAL :: ln_zoom_s = .FALSE. 515 ! LOGICAL :: ln_zoom_e = .FALSE. 516 ! LOGICAL :: ln_zoom_w = .FALSE. 517 ! LOGICAL :: ln_zoom_n = .FALSE. 503 518 !---------------------------------------------------------------- 504 519 NAMELIST /namzgr/ & … … 562 577 563 578 NAMELIST/namgrd/ & !< orca grid namelist 564 & cn_cfg, & !< name of the configuration (orca)565 & in_cfg, & !< resolution of the configuration (2,1,025..)566 & in_bench, & !< benchmark parameter (in_mshhgr = 5 )567 & ln_zoom, & !< use zoom579 ! & cn_cfg, & !< name of the configuration (orca) 580 ! & in_cfg, & !< resolution of the configuration (2,1,025..) 581 ! & in_bench, & !< benchmark parameter (in_mshhgr = 5 ) 582 ! & ln_zoom, & !< use zoom 568 583 & ln_c1d !< use configuration 1D 569 584 570 NAMELIST /namzoom/&571 & cn_cfz, & !< name of the zoom of configuration572 & in_izoom, & !< left bottom i-indices of the zoom in data domain indices573 & in_jzoom, & !< left bottom j-indices of the zoom in data domain indices574 & ln_zoom_s, & !< South zoom type flag575 & ln_zoom_e, & !< East zoom type flag576 & ln_zoom_w, & !< West zoom type flag577 & ln_zoom_n !< North zoom type flag585 ! NAMELIST /namzoom/& 586 ! & cn_cfz, & !< name of the zoom of configuration 587 ! & in_izoom, & !< left bottom i-indices of the zoom in data domain indices 588 ! & in_jzoom, & !< left bottom j-indices of the zoom in data domain indices 589 ! & ln_zoom_s, & !< South zoom type flag 590 ! & ln_zoom_e, & !< East zoom type flag 591 ! & ln_zoom_w, & !< West zoom type flag 592 ! & ln_zoom_n !< North zoom type flag 578 593 !---------------------------------------------------------------- 579 594 !1-2 read namelist … … 604 619 READ( il_fileid, NML = namwd ) 605 620 READ( il_fileid, NML = namgrd ) 606 IF( ln_zoom ) READ( il_fileid, NML = namzoom )621 ! IF( ln_zoom ) READ( il_fileid, NML = namzoom ) 607 622 608 623 CLOSE( il_fileid, IOSTAT=il_status ) … … 667 682 grid_zgr_nam%d_wdld = dn_wdld 668 683 669 grid_zgr_nam%c_cfg = TRIM(cn_cfg)670 grid_zgr_nam%i_cfg = in_cfg671 grid_zgr_nam%i_bench = in_bench672 grid_zgr_nam%l_zoom = ln_zoom684 ! grid_zgr_nam%c_cfg = TRIM(cn_cfg) 685 ! grid_zgr_nam%i_cfg = in_cfg 686 ! grid_zgr_nam%i_bench = in_bench 687 ! grid_zgr_nam%l_zoom = ln_zoom 673 688 grid_zgr_nam%l_c1d = ln_c1d 674 689 675 grid_zgr_nam%c_cfz = cn_cfz676 grid_zgr_nam%i_izoom = in_izoom677 grid_zgr_nam%i_jzoom = in_jzoom678 grid_zgr_nam%l_zoom_s = ln_zoom_s679 grid_zgr_nam%l_zoom_e = ln_zoom_e680 grid_zgr_nam%l_zoom_w = ln_zoom_w681 grid_zgr_nam%l_zoom_n = ln_zoom_n690 ! grid_zgr_nam%c_cfz = cn_cfz 691 ! grid_zgr_nam%i_izoom = in_izoom 692 ! grid_zgr_nam%i_jzoom = in_jzoom 693 ! grid_zgr_nam%l_zoom_s = ln_zoom_s 694 ! grid_zgr_nam%l_zoom_e = ln_zoom_e 695 ! grid_zgr_nam%l_zoom_w = ln_zoom_w 696 ! grid_zgr_nam%l_zoom_n = ln_zoom_n 682 697 683 698 ELSE … … 751 766 752 767 ! Bathymetry fields (levels and meters) 753 CALL grid_zgr__bat( td_nam, jpi,jpj,td_bathy,td_risfdep )768 CALL grid_zgr__bat( td_nam,td_bathy,td_risfdep ) !jpi,jpj,td_bathy,td_risfdep ) 754 769 755 770 ! 1D config.: same bathy value over the 3x3 domain … … 768 783 ! ---------------------------------- 769 784 770 ! correct mbathy in case of zoom subdomain771 IF( td_nam%l_zoom ) CALL grid_zgr__bat_zoom( td_nam,jpi,jpj )785 ! ! correct mbathy in case of zoom subdomain 786 ! IF( td_nam%l_zoom ) CALL grid_zgr__bat_zoom( td_nam,jpi,jpj ) 772 787 773 788 ! check bathymetry (mbathy) and suppress isolated ocean points … … 775 790 776 791 ! deepest ocean level for t-, u- and v-points 777 CALL grid_zgr__bot_level( td_nam,jpi,jpj )792 CALL grid_zgr__bot_level( ) !td_nam,jpi,jpj ) 778 793 779 794 ! shallowest ocean level for T-, U-, V- points 780 CALL grid_zgr__top_level( td_nam,jpi,jpj )795 CALL grid_zgr__top_level( ) !td_nam,jpi,jpj ) 781 796 782 797 ! 1D config.: same mbathy value over the 3x3 domain … … 1038 1053 !> @author J.Paul 1039 1054 !> @date September, 2015 - rewrite from zgr_bat 1055 !> @date October, 2016 1056 !> - do not use anymore special case for ORCA grid. 1040 1057 !> 1041 1058 !> @param[in] td_nam 1042 ! >@param[in] jpi1043 ! >@param[in] jpj1059 ! @param[in] jpi 1060 ! @param[in] jpj 1044 1061 !> @param[in] td_bathy 1045 1062 !> @param[in] td_risfdep 1046 1063 !------------------------------------------------------------------- 1047 SUBROUTINE grid_zgr__bat( td_nam, jpi,jpj,td_bathy,td_risfdep )1064 SUBROUTINE grid_zgr__bat( td_nam,td_bathy,td_risfdep ) !jpi,jpj,td_bathy,td_risfdep ) 1048 1065 IMPLICIT NONE 1049 1066 ! Argument 1050 1067 TYPE(TNAMZ), INTENT(IN ) :: td_nam 1051 INTEGER(i4), INTENT(IN ) :: jpi1052 INTEGER(i4), INTENT(IN ) :: jpj1068 ! INTEGER(i4), INTENT(IN ) :: jpi 1069 ! INTEGER(i4), INTENT(IN ) :: jpj 1053 1070 TYPE(TVAR) , INTENT(INOUT) :: td_bathy 1054 1071 TYPE(TVAR) , INTENT(INOUT) :: td_risfdep 1055 1072 1056 1073 ! local variable 1057 INTEGER(i4) :: ii0, ii11058 INTEGER(i4) :: ij0, ij11074 ! INTEGER(i4) :: ii0, ii1 1075 ! INTEGER(i4) :: ij0, ij1 1059 1076 1060 1077 REAL(dp) :: zhmin … … 1075 1092 tg_misfdep%d_value(:,:,1,1)=1 1076 1093 ! ! ===================== 1077 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN ! ORCA R2 configuration1078 ! ! =====================1079 IF( td_nam%i_cla == 0 ) THEN1080 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open1081 ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995)1082 tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 151083 CALL logger_info('orca_r2: Gibraltar strait open at i='//&1084 & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )1085 !1086 ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open1087 ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995)1088 tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 121089 CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&1090 & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )1091 ENDIF1092 !1093 ENDIF1094 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN ! ORCA R2 configuration 1095 ! ! ! ===================== 1096 ! IF( td_nam%i_cla == 0 ) THEN 1097 ! ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open 1098 ! ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995) 1099 ! tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 15 1100 ! CALL logger_info('orca_r2: Gibraltar strait open at i='//& 1101 ! & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) ) 1102 ! ! 1103 ! ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open 1104 ! ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995) 1105 ! tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 12 1106 ! CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//& 1107 ! & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) ) 1108 ! ENDIF 1109 ! ! 1110 ! ENDIF 1094 1111 1095 1112 ENDIF … … 1115 1132 END IF 1116 1133 ! 1117 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN ! ORCA R2 configuration1118 !1119 IF( td_nam%i_cla == 0 ) THEN1120 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open1121 ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995)1122 td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 284._dp1123 CALL logger_info('orca_r2: Gibraltar strait open at i='//&1124 & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )1125 !1126 ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open1127 ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995)1128 td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 137._dp1129 CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&1130 & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )1131 ENDIF1132 !1133 ENDIF1134 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN ! ORCA R2 configuration 1135 ! ! 1136 ! IF( td_nam%i_cla == 0 ) THEN 1137 ! ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open 1138 ! ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995) 1139 ! td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 284._dp 1140 ! CALL logger_info('orca_r2: Gibraltar strait open at i='//& 1141 ! & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) ) 1142 ! ! 1143 ! ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open 1144 ! ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995) 1145 ! td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 137._dp 1146 ! CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//& 1147 ! & TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) ) 1148 ! ENDIF 1149 ! ! 1150 ! ENDIF 1134 1151 ! 1135 1152 ENDIF … … 1201 1218 1202 1219 END SUBROUTINE grid_zgr__zco 1203 !-------------------------------------------------------------------1204 !> @brief This subroutine :1205 !> - close zoom domain boundary if necessary1206 !> - suppress Med Sea from ORCA R2 and R05 arctic zoom1207 !>1208 !> @author J.Paul1209 !> @date September, 2015 - Initial version1210 !>1211 !> @param[in] td_nam1212 !> @param[in] jpi1213 !> @param[in] jpj1214 !-------------------------------------------------------------------1215 SUBROUTINE grid_zgr__bat_zoom(td_nam,jpi,jpj)1216 IMPLICIT NONE1217 ! Argument1218 TYPE(TNAMZ), INTENT(IN ) :: td_nam1219 INTEGER(i4), INTENT(IN ) :: jpi1220 INTEGER(i4), INTENT(IN ) :: jpj1221 1222 ! local variable1223 INTEGER(i4) :: jpizoom1224 INTEGER(i4) :: jpjzoom1225 1226 INTEGER(i4) :: ii0, ii11227 INTEGER(i4) :: ij0, ij11228 ! loop indices1229 !----------------------------------------------------------------1230 1231 CALL logger_info('GRID ZGR BAT ZOOM : modify the level bathymetry for zoom domain')1232 CALL logger_info('~~~~~~~~~~~~')1233 1234 jpizoom=td_nam%i_izoom1235 jpjzoom=td_nam%i_jzoom1236 1237 ! Forced closed boundary if required1238 IF( td_nam%l_zoom_s ) tg_mbathy%d_value( : , jpjzoom ,1,1) = 01239 IF( td_nam%l_zoom_w ) tg_mbathy%d_value( jpizoom , : ,1,1) = 01240 IF( td_nam%l_zoom_e ) tg_mbathy%d_value( jpi+jpizoom-1, : ,1,1) = 01241 IF( td_nam%l_zoom_n ) tg_mbathy%d_value( : ,jpj+jpjzoom-1,1,1) = 01242 1243 ! Configuration specific domain modifications1244 ! (here, ORCA arctic configuration: suppress Med Sea)1245 IF( TRIM(td_nam%c_cfg) == "orca" .AND. &1246 & TRIM(td_nam%c_cfz) == "arctic" ) THEN1247 SELECT CASE ( td_nam%i_cfg )1248 ! ! =======================1249 CASE ( 2 ) ! ORCA_R2 configuration1250 ! ! =======================1251 CALL logger_info('ORCA R2 arctic zoom: suppress the Med Sea')1252 ii0 = 141 ; ii1 = 162 ! Sea box i,j indices1253 ij0 = 98 ; ij1 = 1101254 ! ! =======================1255 CASE ( 05 ) ! ORCA_R05 configuration1256 ! ! =======================1257 CALL logger_info('ORCA R05 arctic zoom: suppress the Med Sea')1258 ii0 = 563 ; ii1 = 642 ! zero over the Med Sea boxe1259 ij0 = 314 ; ij1 = 3701260 END SELECT1261 !1262 tg_mbathy%d_value( ii0:ii1, ij0:ij1, 1, 1) = 0 ! zero over the Med Sea boxe1263 !1264 ENDIF1265 1266 END SUBROUTINE grid_zgr__bat_zoom1220 ! !------------------------------------------------------------------- 1221 ! !> @brief This subroutine : 1222 ! !> - close zoom domain boundary if necessary 1223 ! !> - suppress Med Sea from ORCA R2 and R05 arctic zoom 1224 ! !> 1225 ! !> @author J.Paul 1226 ! !> @date September, 2015 - Initial version 1227 ! !> 1228 ! !> @param[in] td_nam 1229 ! !> @param[in] jpi 1230 ! !> @param[in] jpj 1231 ! !------------------------------------------------------------------- 1232 ! SUBROUTINE grid_zgr__bat_zoom(td_nam,jpi,jpj) 1233 ! IMPLICIT NONE 1234 ! ! Argument 1235 ! TYPE(TNAMZ), INTENT(IN ) :: td_nam 1236 ! INTEGER(i4), INTENT(IN ) :: jpi 1237 ! INTEGER(i4), INTENT(IN ) :: jpj 1238 ! 1239 ! ! local variable 1240 ! INTEGER(i4) :: jpizoom 1241 ! INTEGER(i4) :: jpjzoom 1242 ! 1243 ! INTEGER(i4) :: ii0, ii1 1244 ! INTEGER(i4) :: ij0, ij1 1245 ! ! loop indices 1246 ! !---------------------------------------------------------------- 1247 ! 1248 ! CALL logger_info('GRID ZGR BAT ZOOM : modify the level bathymetry for zoom domain') 1249 ! CALL logger_info('~~~~~~~~~~~~') 1250 ! 1251 ! jpizoom=td_nam%i_izoom 1252 ! jpjzoom=td_nam%i_jzoom 1253 ! 1254 ! ! Forced closed boundary if required 1255 ! IF( td_nam%l_zoom_s ) tg_mbathy%d_value( : , jpjzoom ,1,1) = 0 1256 ! IF( td_nam%l_zoom_w ) tg_mbathy%d_value( jpizoom , : ,1,1) = 0 1257 ! IF( td_nam%l_zoom_e ) tg_mbathy%d_value( jpi+jpizoom-1, : ,1,1) = 0 1258 ! IF( td_nam%l_zoom_n ) tg_mbathy%d_value( : ,jpj+jpjzoom-1,1,1) = 0 1259 ! 1260 ! ! Configuration specific domain modifications 1261 ! ! (here, ORCA arctic configuration: suppress Med Sea) 1262 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. & 1263 ! & TRIM(td_nam%c_cfz) == "arctic" ) THEN 1264 ! SELECT CASE ( td_nam%i_cfg ) 1265 ! ! ! ======================= 1266 ! CASE ( 2 ) ! ORCA_R2 configuration 1267 ! ! ! ======================= 1268 ! CALL logger_info('ORCA R2 arctic zoom: suppress the Med Sea') 1269 ! ii0 = 141 ; ii1 = 162 ! Sea box i,j indices 1270 ! ij0 = 98 ; ij1 = 110 1271 ! ! ! ======================= 1272 ! CASE ( 05 ) ! ORCA_R05 configuration 1273 ! ! ! ======================= 1274 ! CALL logger_info('ORCA R05 arctic zoom: suppress the Med Sea') 1275 ! ii0 = 563 ; ii1 = 642 ! zero over the Med Sea boxe 1276 ! ij0 = 314 ; ij1 = 370 1277 ! END SELECT 1278 ! ! 1279 ! tg_mbathy%d_value( ii0:ii1, ij0:ij1, 1, 1) = 0 ! zero over the Med Sea boxe 1280 ! ! 1281 ! ENDIF 1282 ! 1283 ! END SUBROUTINE grid_zgr__bat_zoom 1267 1284 !------------------------------------------------------------------- 1268 1285 !> @brief This subroutine check the bathymetry in levels … … 1420 1437 !> @date September, 2015 - rewrite from zgr_bot_level 1421 1438 !> 1422 ! >@param[in] td_nam1423 ! >@param[in] jpi1424 ! >@param[in] jpj1439 ! @param[in] td_nam 1440 ! @param[in] jpi 1441 ! @param[in] jpj 1425 1442 !------------------------------------------------------------------- 1426 SUBROUTINE grid_zgr__bot_level( td_nam,jpi,jpj)1443 SUBROUTINE grid_zgr__bot_level( )!td_nam,jpi,jpj) 1427 1444 IMPLICIT NONE 1428 1445 ! Argument 1429 TYPE(TNAMZ), INTENT(IN ) :: td_nam1430 INTEGER(i4), INTENT(IN ) :: jpi1431 INTEGER(i4), INTENT(IN ) :: jpj1446 ! TYPE(TNAMZ), INTENT(IN ) :: td_nam 1447 ! INTEGER(i4), INTENT(IN ) :: jpi 1448 ! INTEGER(i4), INTENT(IN ) :: jpj 1432 1449 1433 1450 ! local variable … … 1474 1491 !> @date September, 2015 - rewrite from zgr_top_level 1475 1492 !> 1476 ! >@param[in] td_nam1477 ! >@param[in] jpi1478 ! >@param[in] jpj1493 ! @param[in] td_nam 1494 ! @param[in] jpi 1495 ! @param[in] jpj 1479 1496 !------------------------------------------------------------------- 1480 SUBROUTINE grid_zgr__top_level( td_nam,jpi,jpj)1497 SUBROUTINE grid_zgr__top_level( )!td_nam,jpi,jpj) 1481 1498 IMPLICIT NONE 1482 1499 ! Argument 1483 TYPE(TNAMZ), INTENT(IN ) :: td_nam1484 INTEGER(i4), INTENT(IN ) :: jpi1485 INTEGER(i4), INTENT(IN ) :: jpj1500 ! TYPE(TNAMZ), INTENT(IN ) :: td_nam 1501 ! INTEGER(i4), INTENT(IN ) :: jpi 1502 ! INTEGER(i4), INTENT(IN ) :: jpj 1486 1503 ! local variable 1487 1504 … … 2995 3012 INTEGER(i4), INTENT(IN) :: jpi 2996 3013 INTEGER(i4), INTENT(IN) :: jpj 3014 ! LOGICAL , INTENT(IN) :: ld_domcfg 2997 3015 2998 3016 ! local variable … … 3446 3464 CALL grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, & 3447 3465 & dl_scosrf, & 3448 & dl_hift, dl_hifu, dl_hifv , dl_hiff )3466 & dl_hift, dl_hifu, dl_hifv)!, dl_hiff ) 3449 3467 ENDIF 3450 3468 … … 3769 3787 tg_e3v_0%d_value(ji,jj,jk,1) = ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtv3(ji,jj,jk) & 3770 3788 & + td_nam%d_hc / REAL(jpk-1,dp) ) 3771 !tg_e3f_0%d_value(ji,jj,jk,1) = ( (tg_hbatf%d_value(ji,jj,1,1)-td_nam%d_hc)*z_esigtf3(ji,jj,jk) + td_nam%d_hc/REAL(jpk-1,dp) ) 3789 !tg_e3f_0%d_value(ji,jj,jk,1) = ( ( tg_hbatf%d_value(ji,jj,1,1) - td_nam%d_hc ) *z_esigtf3(ji,jj,jk) & 3790 ! & + td_nam%d_hc/REAL(jpk-1,dp) ) 3772 3791 ! 3773 3792 tg_e3w_0%d_value (ji,jj,jk,1)= ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigw3 (ji,jj,jk) & 3774 3793 & + td_nam%d_hc / REAL(jpk-1,dp) ) 3775 !tg_e3uw_0%d_value(ji,jj,jk,1)= ( (tg_hbatu%d_value(ji,jj,1,1)-td_nam%d_hc)*z_esigwu3(ji,jj,jk) + td_nam%d_hc/REAL(jpk-1,dp) ) 3776 !tg_e3vw_0%d_value(ji,jj,jk,1)= ( (tg_hbatv%d_value(ji,jj,1,1)-td_nam%d_hc)*z_esigwv3(ji,jj,jk) + td_nam%d_hc/REAL(jpk-1,dp) ) 3794 !tg_e3uw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwu3(ji,jj,jk) & 3795 ! & + td_nam%d_hc/REAL(jpk-1,dp) ) 3796 !tg_e3vw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwv3(ji,jj,jk) & 3797 ! & + td_nam%d_hc/REAL(jpk-1,dp) ) 3777 3798 END DO 3778 3799 END DO … … 4043 4064 !> @param[in] dd_hifu 4044 4065 !> @param[in] dd_hifv 4045 ! >@param[in] dd_hiff4066 ! @param[in] dd_hiff 4046 4067 !------------------------------------------------------------------- 4047 4068 SUBROUTINE grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, & 4048 4069 & dd_scosrf, & 4049 & dd_hift, dd_hifu, dd_hifv , dd_hiff )4070 & dd_hift, dd_hifu, dd_hifv)!, dd_hiff ) 4050 4071 IMPLICIT NONE 4051 4072 ! Argument … … 4058 4079 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hifu 4059 4080 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hifv 4060 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hiff4081 ! REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hiff 4061 4082 4062 4083 ! local variable -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/iom.f90
r7025 r7153 157 157 !> @author J.Paul 158 158 !> @date November, 2013 - Initial Version 159 !> @date October, 2016160 !> - open cdf4 file as cdf161 159 !> 162 160 !> @param[inout] td_file file structure … … 174 172 SELECT CASE(TRIM(ADJUSTL(fct_lower(td_file%c_type)))) 175 173 176 CASE('cdf' ,'cdf4')174 CASE('cdf') 177 175 CALL iom_cdf_open(td_file) 178 176 CASE('dimg') -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
r7025 r7153 316 316 !> @author J.Paul 317 317 !> @date November, 2013 - Initial Version 318 !> @date October, 2016 319 !> - define cdf4 as cdf. 318 320 ! 319 321 !> @param[inout] td_file file structure … … 340 342 td_file%c_type='cdf' 341 343 CASE(nf90_format_netcdf4, nf90_format_netcdf4_classic) 342 td_file%c_type='cdf4' 344 !td_file%c_type='cdf4' 345 td_file%c_type='cdf' 343 346 END SELECT 344 347 … … 351 354 !> reorder dimension to ('x', 'y', 'z', 't'). 352 355 !> The dimension structure inside file structure is then completed. 353 ! 354 !> @author J.Paul 355 !> @date November, 2013 - Initial Version 356 ! 356 !> 357 !> @author J.Paul 358 !> @date November, 2013 - Initial Version 359 !> @date October, 2016 360 !> - check unknown dimension 361 !> 357 362 !> @param[inout] td_file file structure 358 363 !------------------------------------------------------------------- … … 375 380 376 381 IF( td_file%i_ndim > 0 )THEN 382 377 383 ii=1 378 384 DO ji = 1, td_file%i_ndim 379 385 ! read dimension information 380 386 tl_dim=iom_cdf_read_dim( td_file, ji) 381 IF( .NOT. dim_is_dummy(tl_dim) )THEN 387 ! sname == 'u' if dimension is unknown (not to be used) 388 IF( TRIM(tl_dim%c_sname) /= 'u' )THEN 382 389 IF( ii > ip_maxdim )THEN 383 390 CALL logger_fatal("IOM CDF OPEN: too much dimension "//& 384 & "to be read. you should remove dummy dimension using"//&391 & "to be read. you could choose dimension to be used. see "//& 385 392 & " configuration file") 386 393 ENDIF … … 395 402 & " IOM CDF GET FILE DIM: there is no unlimited dimension in file "//& 396 403 & TRIM(td_file%c_name)) 397 ELSE398 td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE.404 !ELSE 405 ! td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE. 399 406 ENDIF 400 407 … … 466 473 !> The variable structure inside file structure is then completed. 467 474 !> @note variable value are not read ! 468 ! 475 !> 469 476 !> @author J.Paul 470 477 !> @date November, 2013 - Initial Version … … 473 480 !> @date January, 2016 474 481 !> - increment n3d for 4D variable 475 ! 482 !> @date October, 2016 483 !> - check if variable to be used (variable's dimension allowed and variable 484 !> not "dummy") 485 !> 476 486 !> @param[inout] td_file file structure 477 487 !------------------------------------------------------------------- … … 501 511 il_nvar=td_file%i_nvar 502 512 ALLOCATE(tl_var(il_nvar)) 503 ii=0504 513 DO ji = 1, il_nvar 505 514 ! read variable information 506 515 tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 507 IF( .NOT. var_is_dummy(tl_var(ji)) )THEN508 ii=ii+1509 ENDIF510 516 ENDDO 511 517 512 518 ! update number of variable used 513 td_file%i_nvar= ii519 td_file%i_nvar=COUNT(tl_var(:)%l_use) 514 520 515 521 ALLOCATE(td_file%t_var(td_file%i_nvar)) … … 517 523 ii=0 518 524 DO ji = 1, il_nvar 519 IF( .NOT. var_is_dummy(tl_var(ji)))THEN525 IF( tl_var(ji)%l_use )THEN 520 526 ii=ii+1 521 527 td_file%t_var(ii)=var_copy(tl_var(ji)) … … 552 558 td_file%i_timeid=ji 553 559 ELSE 560 IF( td_file%i_timeid /= ji )THEN 561 CALL logger_warn("IOM CDF GET FILE VAR: find more "//& 562 & "than one time variable in file "//& 563 & TRIM(td_file%c_name)//". see "//& 564 & "dummy.cfg configuration file to"//& 565 & " not used dummy variables.") 566 ENDIF 554 567 il_attid=0 555 568 IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN … … 558 571 IF( il_attid /= 0 )THEN 559 572 td_file%i_timeid=ji 560 !ELSE561 ! CALL logger_error("IOM CDF GET FILE VAR: find more "//&562 ! & "than one time variable in file "//&563 ! & TRIM(td_file%c_name) )564 573 ENDIF 565 574 ENDIF … … 1413 1422 ENDDO 1414 1423 1424 !! check if variable is dummy 1425 IF( var_is_dummy(iom_cdf__read_var_meta) )THEN 1426 iom_cdf__read_var_meta%l_use=.FALSE. 1427 ENDIF 1428 1429 !! check if all dimensions are allowed 1430 DO ji=1,il_ndim 1431 IF( ALL(td_file%t_dim(:)%i_id /= il_dimid(ji)) )THEN 1432 iom_cdf__read_var_meta%l_use=.FALSE. 1433 ENDIF 1434 ENDDO 1435 1415 1436 ! clean 1416 1437 CALL dim_clean(tl_dim(:)) … … 1461 1482 1462 1483 ! local variable 1463 INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2 1484 INTEGER(i4), DIMENSION(1) :: il_ind 1485 INTEGER(i4) :: il_xyzt2 1464 1486 1465 1487 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim … … 1484 1506 ELSE IF( id_ndim > 0 )THEN 1485 1507 1486 1487 1508 ii=1 1488 1509 DO ji = 1, id_ndim 1489 1510 1490 ! !! check no dummy dimension to be used1511 ! check if dimension to be used, is allowed 1491 1512 IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN 1492 1513 IF( ii > ip_maxdim )THEN … … 1499 1520 & "dimension "//TRIM(fct_str(ji)) ) 1500 1521 1501 il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2 1522 il_ind(:)= MINLOC(td_file%t_dim(:)%i_id, & 1523 & td_file%t_dim(:)%i_id==id_dimid(ji) ) 1524 il_xyzt2 = td_file%t_dim(il_ind(1))%i_xyzt2 1502 1525 1503 1526 ! read dimension information 1504 tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2 (ii))%c_name, &1505 & td_file%t_dim(il_xyzt2 (ii))%i_len )1506 1527 tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2)%c_name, & 1528 & td_file%t_dim(il_xyzt2)%i_len ) 1529 1507 1530 ii=ii+1 1508 1531 ELSE -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
r7026 r7153 51 51 !> - cn_varcfg : variable configuration file 52 52 !> (see ./SIREN/cfg/variable.cfg) 53 !> - cn_dimcfg : dimension configuration file. define dimension allowed to 54 !> be used (see ./SIREN/cfg/dimension.cfg). 53 55 !> - cn_dumcfg : useless (dummy) configuration file, for useless 54 56 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). … … 133 135 !> @date October, 2016 134 136 !> - allow to choose the number of boundary point with coarse grid value. 137 !> - dimension to be used select from configuration file 135 138 !> 136 139 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 211 214 212 215 ! namcfg 213 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 214 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 216 CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 217 CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 218 CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 215 219 216 220 ! namcrs … … 252 256 NAMELIST /namcfg/ & !< config namelist 253 257 & cn_varcfg, & !< variable configuration file 258 & cn_dimcfg, & !< dimension configuration file 254 259 & cn_dumcfg !< dummy configuration file 255 260 … … 324 329 CALL var_def_extra(TRIM(cn_varcfg)) 325 330 331 ! get dimension allowed 332 CALL dim_def_extra(TRIM(cn_dimcfg)) 333 326 334 ! get dummy variable 327 335 CALL var_get_dummy(TRIM(cn_dumcfg)) … … 626 634 DEALLOCATE(dl_weight) 627 635 CALL boundary_clean(tl_bdy(:)) 636 CALL var_clean_extra() 628 637 629 638 ! close log file … … 850 859 il_width=td_bdy%t_seg(jl)%i_width-id_ncrs 851 860 ! compute "distance" 852 dl_tmp1d(:)=(/(ji,ji=il_width -1,1,-1),(0,ji=1,id_ncrs)/)861 dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/) 853 862 854 863 ! compute weight on segment … … 869 878 il_width=td_bdy%t_seg(jl)%i_width-id_ncrs 870 879 ! compute "distance" 871 dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width -1)/)880 dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/) 872 881 873 882 ! compute weight on segment … … 888 897 il_width=td_bdy%t_seg(jl)%i_width-id_ncrs 889 898 ! compute "distance" 890 dl_tmp1d(:)=(/(ji,ji=il_width -1,1,-1),(0,ji=1,id_ncrs)/)899 dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/) 891 900 892 901 ! compute weight on segment … … 907 916 il_width=td_bdy%t_seg(jl)%i_width-id_ncrs 908 917 ! compute "distance" 909 dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width -1)/)918 dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/) 910 919 911 920 ! compute weight on segment -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/variable.f90
r6393 r7153 34 34 !> Note:<br/> 35 35 !> - others optionals arguments could be added, see var_init. 36 !> - to put variable 0D, use td_dim with all dimension unused36 !> - to put scalar variable (OD), use td_dim with all dimension unused 37 37 !> (td_dim(:)%l_use=.FALSE.) 38 38 !> … … 267 267 !> - cd_varinfo is variable information from namelist 268 268 !> 269 !> to clean global array of variable structure:<br/> 270 !>@code 271 !> CALL var_clean_extra( ) 272 !>@endcode 273 !> 269 274 !> to check variable dimension expected, as defined in file 'variable.cfg':<br/> 270 275 !>@code … … 287 292 !> @date Spetember, 2015 288 293 !> - manage useless (dummy) variable 289 ! 294 !> @date October, 2016 295 !> - add subroutine to clean global array of extra information. 296 !> - define logical for variable to be used 297 !> 290 298 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 291 299 !---------------------------------------------------------------------- … … 337 345 PUBLIC :: var_def_extra !< read variable configuration file, and save extra information. 338 346 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 347 PUBLIC :: var_clean_extra !< clean gloabl array of extra information. 339 348 PUBLIC :: var_check_dim !< check variable dimension expected 340 349 PUBLIC :: var_get_dummy !< fill dummy variable array … … 416 425 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 417 426 418 LOGICAL :: l_file = .FALSE. !< variable read in a file 427 LOGICAL :: l_file = .FALSE. !< variable read in a file 428 LOGICAL :: l_use = .TRUE. !< variable to be used 419 429 420 430 ! highlight some attributes … … 451 461 !< fill when running var_def_extra() 452 462 453 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ), SAVE :: cm_dumvar !< dummy variable463 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumvar !< dummy variable 454 464 455 465 INTERFACE var_init … … 593 603 CALL att_clean(tl_att) 594 604 ENDIF 605 606 var__copy_unit%l_file = td_var%l_file 607 var__copy_unit%l_use = td_var%l_use 595 608 596 609 ! copy highlight attribute … … 6669 6682 ! check if variable is in array of variable structure 6670 6683 DO ji=1,il_size 6684 6671 6685 ! look for variable name 6672 6686 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN … … 6683 6697 6684 6698 ELSE IF( PRESENT(cd_stdname) )THEN 6699 6685 6700 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 6686 6701 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN … … 6690 6705 ENDIF 6691 6706 6707 ENDIF 6708 6692 6709 ! look for variable longname 6693 ELSEIF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&6694 & 6710 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6711 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6695 6712 6696 6713 var_get_index=ji 6697 6714 EXIT 6715 6716 ELSE IF( PRESENT(cd_stdname) )THEN 6717 6718 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 6719 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6720 6721 var_get_index=ji 6722 EXIT 6723 ENDIF 6698 6724 6699 6725 ENDIF … … 6734 6760 ! check if variable is in array of variable structure 6735 6761 DO ji=1,il_size 6762 6736 6763 ! look for variable name 6737 6764 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN … … 6747 6774 EXIT 6748 6775 6749 ! look for variable long name 6750 ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6751 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6752 6753 var_get_id=td_var(ji)%i_id 6754 EXIT 6755 6756 ELSE IF( PRESENT(cd_stdname) )THEN 6776 ELSE IF( PRESENT(cd_stdname) )THEN 6777 6757 6778 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 6758 6779 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN … … 6761 6782 EXIT 6762 6783 ENDIF 6784 6785 ENDIF 6786 6787 ! look for variable long name 6788 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6789 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6790 6791 var_get_id=td_var(ji)%i_id 6792 EXIT 6793 6794 ELSE IF( PRESENT(cd_stdname) )THEN 6795 6796 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 6797 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6798 6799 var_get_id=td_var(ji)%i_id 6800 EXIT 6801 ENDIF 6802 6763 6803 ENDIF 6764 6804 … … 7176 7216 !------------------------------------------------------------------- 7177 7217 !> @brief 7218 !> This subroutine clean global array of variable structure 7219 !> with extra information: tg_varextra. 7220 !> 7221 !> @author J.Paul 7222 !> @date October, 2016 - Initial Version 7223 !------------------------------------------------------------------- 7224 SUBROUTINE var_clean_extra( ) 7225 IMPLICIT NONE 7226 ! Argument 7227 !---------------------------------------------------------------- 7228 7229 CALL var_clean(tg_varextra(:)) 7230 DEALLOCATE(tg_varextra) 7231 7232 END SUBROUTINE var_clean_extra 7233 !------------------------------------------------------------------- 7234 !> @brief 7178 7235 !> This subroutine read matrix value from character string in namelist 7179 7236 !> and fill variable strucutre value. … … 8463 8520 ! loop indices 8464 8521 ! namelist 8465 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumvar8466 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumdim8467 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumatt8522 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 8523 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 8524 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 8468 8525 8469 8526 !---------------------------------------------------------------- … … 8526 8583 8527 8584 var_is_dummy=.FALSE. 8528 DO ji=1,ip_maxdum 8585 DO ji=1,ip_maxdumcfg 8529 8586 IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 8530 8587 var_is_dummy=.TRUE. -
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/templates/create_meshmask.nam
r7025 r7153 16 16 in_perio = !< NEMO periodicity 17 17 ln_closea= 18 ln_c1d= 18 19 / 19 20 … … 81 82 / 82 83 83 &namcla84 in_cla =85 /86 87 &namlbc88 rn_shlat =89 /90 91 84 &namwd !< wetting and drying 92 85 dn_wdmin1 = … … 96 89 97 90 &namgrd 98 cn_cfg =99 91 in_cfg = 100 in_bench = 101 ln_zoom = 92 ln_bench = 102 93 ln_c1d = 103 /104 105 106 &namzoom107 cn_cfz =108 in_izoom =109 in_jzoom =110 ln_zoom_s=111 ln_zoom_e=112 ln_zoom_w=113 ln_zoom_n=114 94 / 115 95
Note: See TracChangeset
for help on using the changeset viewer.