Changeset 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
- Timestamp:
- 2018-10-29T15:20:26+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
r10248 r10251 105 105 IMPLICIT NONE 106 106 ! 107 REAL*8 :: za 2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax107 REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 108 108 TYPE(Coordinates) :: Grid 109 109 INTEGER :: i,j … … 134 134 za0 = pa0 135 135 za1 = pa1 136 za2 = pa2137 136 ! 138 137 ELSE … … 148 147 149 148 zacr = ppacr 150 zkth = ppkth 151 zacr2 = ppacr2 152 zkth2 = ppkth2 149 zkth = ppkth 150 153 151 ! 154 152 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 155 153 ! 156 IF( ppkth == 0. ) THEN ! uniform vertical grid 157 za1 = pphmax / FLOAT(N-1) 158 DO i = 1, N 159 gdepw(i) = ( i - 1 ) * za1 160 gdept(i) = ( i - 0.5 ) * za1 161 e3w (i) = za1 162 e3t (i) = za1 163 END DO 164 ELSE ! Madec & Imbard 1996 function 165 IF( .NOT. ldbletanh ) THEN 166 DO i = 1,N 167 ! 168 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 169 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 170 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 171 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 172 ! 173 END DO 174 ELSE 175 DO i = 1,N 176 ! Double tanh function 177 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 178 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 179 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 180 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 181 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 182 & + za2 * TANH( (i-zkth2) / zacr2 ) 183 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 184 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 185 END DO 186 ENDIF 187 ENDIF 154 DO i = 1,N 155 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 156 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 157 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 158 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 159 END DO 188 160 ! 189 161 gdepw(1) = 0.0 190 162 zmax = gdepw(N) + e3t(N) 191 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 192 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 193 ENDIF 194 zmin = gdepw(i+1) 163 zmin = gdepw(4) 195 164 ! 196 165 IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & … … 258 227 IMPLICIT NONE 259 228 ! 260 REAL*8 :: za 2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax229 REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 261 230 TYPE(Coordinates) :: Grid 262 231 INTEGER :: i,j … … 288 257 za0 = pa0 289 258 za1 = pa1 290 za2 = pa2291 259 ! 292 260 ELSE … … 296 264 WRITE(*,*) 'please check values of variables' 297 265 WRITE(*,*) 'in namelist vertical_grid section' 298 WRITE(*,*) ' ' 299 STOP 266 WRITE(*,*) ' ' 267 STOP 300 268 ! 301 269 ENDIF 302 270 ! 303 271 zacr = ppacr 304 zkth = ppkth 305 zacr2 = ppacr2 306 zkth2 = ppkth2 272 zkth = ppkth 273 307 274 ! 308 275 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 309 276 ! 310 IF( ppkth == 0. ) THEN ! uniform vertical grid 311 za1 = pphmax / FLOAT(N-1) 312 DO i = 1, N 313 gdepw(i) = ( i - 1 ) * za1 314 gdept(i) = ( i - 0.5 ) * za1 315 e3w (i) = za1 316 e3t (i) = za1 317 END DO 318 ELSE ! Madec & Imbard 1996 function 319 IF( .NOT. ldbletanh ) THEN 320 DO i = 1,N 321 ! 322 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 323 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 324 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 325 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 326 ! 327 END DO 328 ELSE 329 DO i = 1,N 330 ! Double tanh function 331 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 332 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 333 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 334 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 335 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 336 & + za2 * TANH( (i-zkth2) / zacr2 ) 337 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 338 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 339 END DO 340 ENDIF 341 ENDIF 277 DO i = 1,N 278 ! 279 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 280 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 281 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 282 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 283 END DO 342 284 ! 343 285 gdepw(1) = 0.0 … … 742 684 ! for consistency with fine grid bathymetry * 743 685 ! * 744 ! if a given coarse grid point is masked and one of the 745 ! child grid points contained in this coarse cell is not masked 746 ! the corresponding coarse grid point is unmasked with rn_hmin*747 ! value 686 ! if a given coarse grid point is masked and one of the * 687 ! child grid points contained in this coarse cell is not masked * 688 ! the corresponding coarse grid point is unmasked with gdepw(4) * 689 ! value * 748 690 ! * 749 691 ! - input : * … … 762 704 ! 763 705 INTEGER :: ideb,jdeb,ifin,jfin 764 REAL*8 :: za 2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin706 REAL*8 :: za1,za0,zsur,zacr,zkth,zmin 765 707 INTEGER :: i,j 766 708 INTEGER :: k1 … … 785 727 za0 = pa0 786 728 za1 = pa1 787 za2 = pa2788 729 ! 789 730 ELSE … … 799 740 800 741 zacr = ppacr 801 zkth = ppkth 802 zacr2 = ppacr2 803 zkth2 = ppkth2 742 zkth = ppkth 743 804 744 ! 805 745 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 806 746 ! 807 IF( ppkth == 0. ) THEN ! uniform vertical grid 808 za1 = pphmax / FLOAT(N-1) 809 DO i = 1, N 810 gdepw(i) = ( i - 1 ) * za1 811 gdept(i) = ( i - 0.5 ) * za1 812 e3w (i) = za1 813 e3t (i) = za1 814 END DO 815 ELSE ! Madec & Imbard 1996 function 816 IF( .NOT. ldbletanh ) THEN 817 DO i = 1,N 818 ! 819 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 820 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 821 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 822 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 823 ! 824 END DO 825 ELSE 826 DO i = 1,N 827 ! Double tanh function 828 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 829 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 830 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 831 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 832 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 833 & + za2 * TANH( (i-zkth2) / zacr2 ) 834 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 835 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 836 END DO 837 ENDIF 838 ENDIF 839 ! 840 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 841 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 842 ENDIF 843 zmin = gdepw(i+1) 747 DO i = 1,N 748 ! 749 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 750 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 751 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 752 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 753 END DO 754 ! 755 zmin = gdepw(4) 844 756 ! 845 757 diff = 0
Note: See TracChangeset
for help on using the changeset viewer.