- Timestamp:
- 2020-06-24T14:38:26+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/DOM/domain.F90
r12489 r13151 6 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea … … 15 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 17 !! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 17 18 !!---------------------------------------------------------------------- 18 19 19 20 !!---------------------------------------------------------------------- 20 21 !! dom_init : initialize the space and time domain … … 34 35 USE dommsk ! domain: set the mask system 35 36 USE domwri ! domain: write the meshmask file 37 #if ! defined key_qco 36 38 USE domvvl ! variable volume 39 #else 40 USE domqco ! variable volume 41 #endif 37 42 USE c1d ! 1D configuration 38 43 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) … … 61 66 !!---------------------------------------------------------------------- 62 67 !! *** ROUTINE dom_init *** 63 !! 64 !! ** Purpose : Domain initialization. Call the routines that are 65 !! required to create the arrays which define the space 68 !! 69 !! ** Purpose : Domain initialization. Call the routines that are 70 !! required to create the arrays which define the space 66 71 !! and time domain of the ocean model. 67 72 !! … … 76 81 CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables 77 82 ! 78 INTEGER :: ji, jj, jk, ik! dummy loop indices83 INTEGER :: ji, jj, jk, jt ! dummy loop indices 79 84 INTEGER :: iconf = 0 ! local integers 80 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 85 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 81 86 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 82 87 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 110 115 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)' 111 116 CASE DEFAULT 112 CALL ctl_stop( ' jperio is out of range' )117 CALL ctl_stop( 'dom_init: jperio is out of range' ) 113 118 END SELECT 114 119 WRITE(numout,*) ' Ocean model configuration used:' … … 140 145 IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes 141 146 142 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry 147 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices) 143 148 144 149 CALL dom_msk( ik_top, ik_bot ) ! Masks … … 147 152 hu_0(:,:) = 0._wp 148 153 hv_0(:,:) = 0._wp 154 hf_0(:,:) = 0._wp 149 155 DO jk = 1, jpk 150 156 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 151 157 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 152 158 hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 159 hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk) 153 160 END DO 154 161 ! 162 r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp - ssmask (:,:) ) 163 r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) 164 r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 165 r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) ) 166 167 ! 168 #if defined key_qco 169 ! !== initialisation of time varying coordinate ==! Quasi-Euerian coordinate case 170 ! 171 IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa ) 172 ! 173 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 174 ! 175 #else 155 176 ! !== time varying part of coordinate system ==! 156 177 ! 157 178 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 158 !159 ! before ! now ! after !160 gdept(:,:,:, Kbb) = gdept_0 ; gdept(:,:,:,Kmm) = gdept_0 ; gdept(:,:,:,Kaa) = gdept_0 ! depth of grid-points161 gdepw(:,:,:, Kbb) = gdepw_0 ; gdepw(:,:,:,Kmm) = gdepw_0 ; gdepw(:,:,:,Kaa) = gdepw_0 !162 gde3w = gde3w_0 ! --- !163 !164 e3t(:,:,:,Kbb) = e3t_0 ; e3t(:,:,:,Kmm) = e3t_0 ; e3t(:,:,:,Kaa) = e3t_0 ! scale factors165 e3u(:,:,:,Kbb) = e3u_0 ; e3u(:,:,:,Kmm) = e3u_0 ; e3u(:,:,:,Kaa) = e3u_0 !166 e3v(:,:,:,Kbb) = e3v_0 ; e3v(:,:,:,Kmm) = e3v_0 ; e3v(:,:,:,Kaa) = e3v_0 !167 e3f = e3f_0 ! --- !168 e3w(:,:,:,Kbb) = e3w_0 ; e3w(:,:,:,Kmm) = e3w_0 ; e3w(:,:,:,Kaa) = e3w_0 !169 e3uw(:,:,:,Kbb) = e3uw_0 ; e3uw(:,:,:,Kmm) = e3uw_0 ; e3uw(:,:,:,Kaa) = e3uw_0 !170 e3vw(:,:,:,Kbb) = e3vw_0 ; e3vw(:,:,:,Kmm) = e3vw_0 ; e3vw(:,:,:,Kaa) = e3vw_0 !171 !172 z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF173 z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:))174 ! 175 ! before ! now ! after !176 ht = ht_0 ! ! water column thickness177 hu(:,:,Kbb) = hu_0 ; hu(:,:,Kmm) = hu_0 ; hu(:,:,Kaa) = hu_0 !178 hv(:,:,Kbb) = hv_0 ; hv(:,:,Kmm) = hv_0 ; hv(:,:,Kaa) = hv_0 !179 r1_h u(:,:,Kbb) = z1_hu_0 ; r1_hu(:,:,Kmm) = z1_hu_0 ; r1_hu(:,:,Kaa) = z1_hu_0 ! inverse of water column thickness180 r1_hv(:,:,Kbb) = z1_hv_0 ; r1_hv(:,:,Kmm) = z1_hv_0 ; r1_hv(:,:,Kaa) = z1_hv_0 !181 !179 ! 180 DO jt = 1, jpt ! depth of t- and w-grid-points 181 gdept(:,:,:,jt) = gdept_0(:,:,:) 182 gdepw(:,:,:,jt) = gdepw_0(:,:,:) 183 END DO 184 gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t 185 ! 186 DO jt = 1, jpt ! vertical scale factors 187 e3t(:,:,:,jt) = e3t_0(:,:,:) 188 e3u(:,:,:,jt) = e3u_0(:,:,:) 189 e3v(:,:,:,jt) = e3v_0(:,:,:) 190 e3w(:,:,:,jt) = e3w_0(:,:,:) 191 e3uw(:,:,:,jt) = e3uw_0(:,:,:) 192 e3vw(:,:,:,jt) = e3vw_0(:,:,:) 193 END DO 194 e3f(:,:,:) = e3f_0(:,:,:) 195 ! 196 DO jt = 1, jpt ! water column thickness and its inverse 197 hu(:,:,jt) = hu_0(:,:) 198 hv(:,:,jt) = hv_0(:,:) 199 r1_hu(:,:,jt) = r1_hu_0(:,:) 200 r1_hv(:,:,jt) = r1_hv_0(:,:) 201 END DO 202 ht(:,:) = ht_0(:,:) 182 203 ! 183 204 ELSE != time varying : initialize before/now/after variables 184 205 ! 185 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 186 ! 187 ENDIF 206 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 207 ! 208 ENDIF 209 #endif 210 188 211 ! 189 212 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point … … 198 221 WRITE(numout,*) 'dom_init : ==>>> END of domain initialization' 199 222 WRITE(numout,*) '~~~~~~~~' 200 WRITE(numout,*) 223 WRITE(numout,*) 201 224 ENDIF 202 225 ! … … 210 233 !! ** Purpose : initialization of global domain <--> local domain indices 211 234 !! 212 !! ** Method : 235 !! ** Method : 213 236 !! 214 237 !! ** Action : - mig , mjg : local domain indices ==> global domain indices … … 226 249 END DO 227 250 ! ! global domain indices ==> local domain indices 228 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 229 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 251 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 252 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 230 253 DO ji = 1, jpiglo 231 254 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) … … 273 296 !!---------------------------------------------------------------------- 274 297 !! *** ROUTINE dom_nam *** 275 !! 298 !! 276 299 !! ** Purpose : read domaine namelists and print the variables. 277 300 !! … … 355 378 l_1st_euler = ln_1st_euler 356 379 IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 357 IF(lwp) WRITE(numout,*) 380 IF(lwp) WRITE(numout,*) 358 381 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 359 382 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' … … 383 406 IF(lwp) WRITE(numout,*) 384 407 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 385 CASE ( 1 ) 408 CASE ( 1 ) 386 409 CALL ioconf_calendar('gregorian') 387 410 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' … … 419 442 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 420 443 lrxios = ln_xios_read.AND.ln_rstart 421 !set output file type for XIOS based on NEMO namelist 422 IF (nn_wxios > 0) lwxios = .TRUE. 444 !set output file type for XIOS based on NEMO namelist 445 IF (nn_wxios > 0) lwxios = .TRUE. 423 446 nxioso = nn_wxios 424 447 ENDIF … … 463 486 !!---------------------------------------------------------------------- 464 487 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2 465 INTEGER, DIMENSION(2) :: iloc ! 488 INTEGER, DIMENSION(2) :: iloc ! 466 489 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 467 490 !!---------------------------------------------------------------------- … … 473 496 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 474 497 ELSE 475 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 476 ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 477 ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 478 ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 498 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 499 ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 500 ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 501 ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 479 502 ! 480 503 iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) … … 507 530 !!---------------------------------------------------------------------- 508 531 !! *** ROUTINE dom_nam *** 509 !! 532 !! 510 533 !! ** Purpose : read the domain size in domain configuration file 511 534 !! … … 514 537 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 515 538 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 516 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 517 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 539 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 540 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 518 541 ! 519 542 INTEGER :: inum ! local integer … … 547 570 cd_cfg = 'UNKNOWN' 548 571 kk_cfg = -9999999 549 !- or they may be present as global attributes 550 !- (netcdf only) 572 !- or they may be present as global attributes 573 !- (netcdf only) 551 574 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 552 575 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found … … 570 593 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio 571 594 ENDIF 572 ! 595 ! 573 596 END SUBROUTINE domain_cfg 574 575 597 598 576 599 SUBROUTINE cfg_write 577 600 !!---------------------------------------------------------------------- 578 601 !! *** ROUTINE cfg_write *** 579 !! 580 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 581 !! contains all the ocean domain informations required to 602 !! 603 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 604 !! contains all the ocean domain informations required to 582 605 !! define an ocean configuration. 583 606 !! … … 585 608 !! ocean configuration. 586 609 !! 587 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 610 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 588 611 !! mesh, Coriolis parameter, and vertical scale factors 589 612 !! NB: also contain ORCA family information … … 603 626 ! ! create 'domcfg_out.nc' file ! 604 627 ! ! ============================= ! 605 ! 628 ! 606 629 clnam = cn_domcfg_out ! filename (configuration information) 607 630 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 608 631 609 632 ! 610 633 ! !== ORCA family specificities ==! 611 634 IF( cn_cfg == "ORCA" ) THEN 612 635 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 613 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 636 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 614 637 ENDIF 615 638 ! … … 643 666 CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 644 667 CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 645 ! 668 ! 646 669 CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude 647 670 CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 648 671 CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 649 672 CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 650 ! 673 ! 651 674 CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.) 652 675 CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 ) … … 663 686 ! 664 687 ! !== vertical mesh ==! 665 ! 688 ! 666 689 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate 667 690 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 ) … … 674 697 CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 ) 675 698 CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 ) 676 ! 699 ! 677 700 ! !== wet top and bottom level ==! (caution: multiplied by ssmask) 678 701 ! … … 694 717 ! 695 718 ! ! ============================ 696 ! ! close the files 719 ! ! close the files 697 720 ! ! ============================ 698 721 CALL iom_close( inum )
Note: See TracChangeset
for help on using the changeset viewer.
