Changeset 6440 for branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
- Timestamp:
- 2016-04-07T16:32:24+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
r6439 r6440 105 105 IMPLICIT NONE 106 106 ! 107 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin,zmax107 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 108 108 TYPE(Coordinates) :: Grid 109 109 INTEGER :: i,j … … 134 134 za0 = pa0 135 135 za1 = pa1 136 za2 = pa2 136 137 ! 137 138 ELSE … … 147 148 148 149 zacr = ppacr 149 zkth = ppkth 150 150 zkth = ppkth 151 zacr2 = ppacr2 152 zkth2 = ppkth2 151 153 ! 152 154 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 153 155 ! 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 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 160 188 ! 161 189 gdepw(1) = 0.0 162 190 zmax = gdepw(N) + e3t(N) 163 zmin = gdepw(4) 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) 164 195 ! 165 196 IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & … … 227 258 IMPLICIT NONE 228 259 ! 229 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin,zmax260 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 230 261 TYPE(Coordinates) :: Grid 231 262 INTEGER :: i,j … … 257 288 za0 = pa0 258 289 za1 = pa1 290 za2 = pa2 259 291 ! 260 292 ELSE … … 264 296 WRITE(*,*) 'please check values of variables' 265 297 WRITE(*,*) 'in namelist vertical_grid section' 266 WRITE(*,*) ' ' 267 STOP 298 WRITE(*,*) ' ' 299 STOP 268 300 ! 269 301 ENDIF 270 ! 302 271 303 zacr = ppacr 272 zkth = ppkth 273 304 zkth = ppkth 305 zacr2 = ppacr2 306 zkth2 = ppkth2 274 307 ! 275 308 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 276 309 ! 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 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 284 342 ! 285 343 gdepw(1) = 0.0 … … 684 742 ! for consistency with fine grid bathymetry * 685 743 ! * 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 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 * 690 748 ! * 691 749 ! - input : * … … 704 762 ! 705 763 INTEGER :: ideb,jdeb,ifin,jfin 706 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin764 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin 707 765 INTEGER :: i,j 708 766 INTEGER :: k1 … … 727 785 za0 = pa0 728 786 za1 = pa1 787 za2 = pa2 729 788 ! 730 789 ELSE … … 740 799 741 800 zacr = ppacr 742 zkth = ppkth 743 801 zkth = ppkth 802 zacr2 = ppacr2 803 zkth2 = ppkth2 744 804 ! 745 805 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 746 806 ! 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) 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) 756 844 ! 757 845 diff = 0
Note: See TracChangeset
for help on using the changeset viewer.