- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5836 r6060 13 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 15 16 !!---------------------------------------------------------------------- 16 17 … … 36 37 ! 37 38 USE in_out_manager ! I/O manager 39 USE wrk_nemo ! Memory Allocation 38 40 USE lib_mpp ! distributed memory computing library 39 41 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 45 47 PUBLIC dom_init ! called by opa.F90 46 48 47 !! * Substitutions48 # include "domzgr_substitute.h90"49 49 !!------------------------------------------------------------------------- 50 50 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 70 70 !! - 1D configuration, move Coriolis, u and v at T-point 71 71 !!---------------------------------------------------------------------- 72 INTEGER :: jk ! dummy loop argument72 INTEGER :: jk ! dummy loop indices 73 73 INTEGER :: iconf = 0 ! local integers 74 REAL(wp), POINTER, DIMENSION(:,:) :: z1_hu_0, z1_hv_0 74 75 !!---------------------------------------------------------------------- 75 76 ! … … 82 83 ENDIF 83 84 ! 84 CALL dom_nam ! read namelist ( namrun, namdom ) 85 CALL dom_clo ! Closed seas and lake 86 CALL dom_hgr ! Horizontal mesh 87 CALL dom_zgr ! Vertical mesh and bathymetry 88 CALL dom_msk ! Masks 89 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 90 ! 91 ht_0(:,:) = 0._wp ! Reference ocean depth at T-points 92 hu_0(:,:) = 0._wp ! Reference ocean depth at U-points 93 hv_0(:,:) = 0._wp ! Reference ocean depth at V-points 94 DO jk = 1, jpk 85 ! !== Reference coordinate system ==! 86 ! 87 CALL dom_nam ! read namelist ( namrun, namdom ) 88 CALL dom_clo ! Closed seas and lake 89 CALL dom_hgr ! Horizontal mesh 90 CALL dom_zgr ! Vertical mesh and bathymetry 91 CALL dom_msk ! Masks 92 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 93 ! 94 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1) ! Reference ocean thickness 95 hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1) 96 hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 97 DO jk = 2, jpk 95 98 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 96 99 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) … … 98 101 END DO 99 102 ! 100 IF( lk_vvl ) CALL dom_vvl_init ! Vertical variable mesh 101 ! 102 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 103 ! 104 ! 105 hu(:,:) = 0._wp ! Ocean depth at U-points 106 hv(:,:) = 0._wp ! Ocean depth at V-points 107 ht(:,:) = 0._wp ! Ocean depth at T-points 108 DO jk = 1, jpkm1 109 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 110 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 111 ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 112 END DO 113 ! ! Inverse of the local depth 114 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 115 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 116 117 CALL dom_stp ! time step 118 IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file 119 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 103 ! !== time varying part of coordinate system ==! 104 ! 105 IF( ln_linssh ) THEN ! Fix in time : set to the reference one for all 106 ! before ! now ! after ! 107 ; gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 108 ; gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 109 ; ; gde3w_n = gde3w_0 ! --- ! 110 ! 111 ; e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 112 ; e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 113 ; e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 114 ; ; e3f_n = e3f_0 ! --- ! 115 ; e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 116 ; e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 117 ; e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 118 ! 119 CALL wrk_alloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 120 ! 121 z1_hu_0(:,:) = umask_i(:,:) / ( hu_0(:,:) + 1._wp - umask_i(:,:) ) ! _i mask due to ISF 122 z1_hv_0(:,:) = vmask_i(:,:) / ( hv_0(:,:) + 1._wp - vmask_i(:,:) ) 123 ! 124 ! before ! now ! after ! 125 ; ; ht_n = ht_0 ! ! water column thickness 126 ; hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 ! 127 ; hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 ! 128 ; r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness 129 ; r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 ! 130 ! 131 CALL wrk_dealloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 132 ! 133 ELSE ! time varying : initialize before/now/after variables 134 ! 135 CALL dom_vvl_init 136 ! 137 ENDIF 138 ! 139 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 140 ! 141 CALL dom_stp ! time step 142 IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file 143 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 120 144 ! 121 145 IF( nn_timing == 1 ) CALL timing_stop('dom_init') … … 403 427 INTEGER :: ji, jj, jk 404 428 REAL(wp) :: zrxmax 405 REAL(wp), DIMENSION(4) :: zr1429 REAL(wp), DIMENSION(4) :: zr1 406 430 !!---------------------------------------------------------------------- 407 431 rx1(:,:) = 0._wp … … 412 436 DO jj = 2, jpjm1 413 437 DO jk = 1, jpkm1 414 zr1(1) = umask(ji-1,jj ,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji-1,jj ,jk )&415 & +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1))&416 & /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji-1,jj ,jk )&417 & -gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1) + rsmall))418 zr1(2) = umask(ji ,jj ,jk) *abs( (gdepw_0(ji+1,jj ,jk )-gdepw_0(ji ,jj ,jk )&419 & +gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1))&420 & /(gdepw_0(ji+1,jj ,jk )+gdepw_0(ji ,jj ,jk )&421 & -gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall))422 zr1(3) = vmask(ji ,jj ,jk) *abs( (gdepw_0(ji ,jj+1,jk )-gdepw_0(ji ,jj ,jk )&423 & +gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1))&424 & /(gdepw_0(ji ,jj+1,jk )+gdepw_0(ji ,jj ,jk )&425 & -gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall))426 zr1(4) = vmask(ji ,jj-1,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji ,jj-1,jk )&427 & +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1))&428 & /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji ,jj-1,jk )&429 & -gdepw_0(ji, jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1) + rsmall))430 zrxmax = MAXVAL( zr1(1:4))431 rx1(ji,jj) = MAX( rx1(ji,jj), zrxmax)438 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) & 439 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) & 440 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) & 441 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk) 442 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) & 443 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) & 444 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 445 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 446 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 447 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 448 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & 449 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk) 450 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) & 451 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) & 452 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) & 453 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk) 454 zrxmax = MAXVAL( zr1(1:4) ) 455 rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax ) 432 456 END DO 433 457 END DO
Note: See TracChangeset
for help on using the changeset viewer.
