Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icbutl.F90
- Timestamp:
- 2021-11-26T12:27:56+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icbutl.F90
r14652 r15540 75 75 !! ** Method : - blah blah 76 76 !!---------------------------------------------------------------------- 77 REAL( wp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp77 REAL(dp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp 78 78 #if defined key_si3 79 79 REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m ! ocean surface (ssh_m) if ice is not embedded … … 159 159 !! 160 160 !!---------------------------------------------------------------------- 161 REAL( wp), INTENT(in ) :: pi , pj ! position in (i,j) referential162 REAL( wp), INTENT( out), OPTIONAL :: pe1, pe2 ! i- and j scale factors163 REAL( wp), INTENT( out), OPTIONAL :: pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds164 REAL( wp), INTENT( out), OPTIONAL :: pssh_i, pssh_j ! ssh i- & j-gradients165 REAL( wp), INTENT( out), OPTIONAL :: psst, psss, pcn, phi, pff ! SST, SSS, ice concentration, ice thickness, Coriolis166 REAL( wp), INTENT( out), OPTIONAL :: plat, plon ! position167 REAL( wp), DIMENSION(jpk), INTENT( out), OPTIONAL :: ptoce, puoce, pvoce, pe3t ! 3D variables168 ! 169 REAL( wp), DIMENSION(4) :: zwT , zwU , zwV , zwF ! interpolation weight170 REAL( wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask171 REAL( wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm172 REAL( wp), DIMENSION(4,jpk) :: zw1d161 REAL(dp), INTENT(in ) :: pi , pj ! position in (i,j) referential 162 REAL(dp), INTENT( out), OPTIONAL :: pe1, pe2 ! i- and j scale factors 163 REAL(dp), INTENT( out), OPTIONAL :: pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds 164 REAL(dp), INTENT( out), OPTIONAL :: pssh_i, pssh_j ! ssh i- & j-gradients 165 REAL(dp), INTENT( out), OPTIONAL :: psst, psss, pcn, phi, pff ! SST, SSS, ice concentration, ice thickness, Coriolis 166 REAL(dp), INTENT( out), OPTIONAL :: plat, plon ! position 167 REAL(dp), DIMENSION(jpk), INTENT( out), OPTIONAL :: ptoce, puoce, pvoce, pe3t ! 3D variables 168 ! 169 REAL(dp), DIMENSION(4) :: zwT , zwU , zwV , zwF ! interpolation weight 170 REAL(dp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 171 REAL(dp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 172 REAL(dp), DIMENSION(4,jpk) :: zw1d 173 173 INTEGER :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 174 174 INTEGER :: iiTp, iiTm, ijTp, ijTm 175 REAL( wp) :: zcd, zmod ! local scalars175 REAL(dp) :: zcd, zmod ! local scalars 176 176 !!---------------------------------------------------------------------- 177 177 ! … … 183 183 ! 184 184 ! metrics and coordinates 185 IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( CASTWP(e1t), CASTWP(e1u), e1v, CASTWP(e1f), pi, pj ) ! scale factors186 IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( CASTWP(e2t), e2u, CASTWP(e2v), CASTWP(e2f), pi, pj )185 IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 186 IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 187 187 IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true. ) 188 188 IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) … … 219 219 CALL icb_utl_pos( pi-0.1_wp, pj , 'T', iiTm, ijTm, zwTm, zmskTm ) 220 220 ! 221 IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( CASTWP(e1t), CASTWP(e1u), e1v, CASTWP(e1f), pi, pj )221 IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 222 222 pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 223 223 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe1 ) … … 226 226 CALL icb_utl_pos( pi , pj-0.1_wp, 'T', iiTm, ijTm, zwTm, zmskTm ) 227 227 ! 228 IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( CASTWP(e2t), e2u, CASTWP(e2v), CASTWP(e2f), pi, pj )228 IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 229 229 pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 230 230 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe2 ) … … 266 266 !! 267 267 !!---------------------------------------------------------------------- 268 REAL( wp) , INTENT(IN) :: pi, pj ! targeted coordinates in (i,j) referential268 REAL(dp) , INTENT(IN) :: pi, pj ! targeted coordinates in (i,j) referential 269 269 CHARACTER(len=1) , INTENT(IN) :: cd_type ! point type 270 REAL( wp), DIMENSION(4), INTENT(OUT) :: pw, pmsk ! weight and mask270 REAL(dp), DIMENSION(4), INTENT(OUT) :: pw, pmsk ! weight and mask 271 271 INTEGER , INTENT(OUT) :: kii, kij ! bottom left corner position in local domain 272 272 ! 273 REAL( wp) :: zwi, zwj ! distance to bottom left corner273 REAL(dp) :: zwi, zwj ! distance to bottom left corner 274 274 INTEGER :: ierr 275 275 ! … … 359 359 END SUBROUTINE icb_utl_pos 360 360 361 REAL( wp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon )361 REAL(dp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon ) 362 362 !!---------------------------------------------------------------------- 363 363 !! *** FUNCTION icb_utl_bilin *** … … 370 370 !! 371 371 !!---------------------------------------------------------------------- 372 REAL( wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated373 REAL( wp), DIMENSION(4) , INTENT(in) :: pw ! weight372 REAL(dp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated 373 REAL(dp), DIMENSION(4) , INTENT(in) :: pw ! weight 374 374 LOGICAL , INTENT(in) :: pllon ! input data is a longitude 375 375 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 376 376 ! 377 REAL( wp), DIMENSION(4) :: zdat ! input data377 REAL(dp), DIMENSION(4) :: zdat ! input data 378 378 !!---------------------------------------------------------------------- 379 379 ! … … 406 406 !! 407 407 !!---------------------------------------------------------------------- 408 REAL( wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) :: pfld ! field to be interpolated409 REAL( wp), DIMENSION(4,jpk) , INTENT(in) :: pw ! weight408 REAL(dp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) :: pfld ! field to be interpolated 409 REAL(dp), DIMENSION(4,jpk) , INTENT(in) :: pw ! weight 410 410 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 411 REAL( wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h412 ! 413 REAL( wp), DIMENSION(4,jpk) :: zdat ! input data411 REAL(dp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 412 ! 413 REAL(dp), DIMENSION(4,jpk) :: zdat ! input data 414 414 INTEGER :: jk 415 415 !!---------------------------------------------------------------------- … … 429 429 END FUNCTION icb_utl_bilin_3d_h 430 430 431 REAL( wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj )431 REAL(dp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) 432 432 !!---------------------------------------------------------------------- 433 433 !! *** FUNCTION dom_init *** … … 437 437 !! t-, u-, v-, and f-points. 438 438 !!---------------------------------------------------------------------- 439 REAL( wp), DIMENSION(:,:), INTENT(in) :: pet, peu, pev, pef ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts440 REAL( wp) , INTENT(IN) :: pi , pj ! iceberg position439 REAL(dp), DIMENSION(:,:), INTENT(in) :: pet, peu, pev, pef ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts 440 REAL(dp) , INTENT(IN) :: pi , pj ! iceberg position 441 441 ! 442 442 ! weights corresponding to corner points of a T cell quadrant 443 REAL( wp) :: zi, zj ! local real443 REAL(dp) :: zi, zj ! local real 444 444 INTEGER :: ii, ij ! bottom left corner coordinate in local domain 445 445 ! 446 446 ! values at corner points of a T cell quadrant 447 447 ! 00 = bottom left, 10 = bottom right, 01 = top left, 11 = top right 448 REAL( wp) :: ze00, ze10, ze01, ze11448 REAL(dp) :: ze00, ze10, ze01, ze11 449 449 !!---------------------------------------------------------------------- 450 450 ! … … 508 508 !!---------------------------------------------------------------------- 509 509 INTEGER, INTENT(out):: kb 510 REAL( wp), DIMENSION(:), INTENT(in) :: pe3511 REAL( wp), INTENT(in) :: pD510 REAL(dp), DIMENSION(:), INTENT(in) :: pe3 511 REAL(dp), INTENT(in) :: pD 512 512 !! 513 513 INTEGER :: jk 514 REAL( wp) :: zdepw514 REAL(dp) :: zdepw 515 515 !!---------------------------------------------------------------------- 516 516 !! … … 531 531 !!---------------------------------------------------------------------- 532 532 INTEGER, INTENT(in ) :: kb ! deepest level affected by icb 533 REAL( wp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile534 REAL( wp), INTENT(in ) :: pD ! draft535 REAL( wp), INTENT(out) :: pzavg ! z average533 REAL(dp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile 534 REAL(dp), INTENT(in ) :: pD ! draft 535 REAL(dp), INTENT(out) :: pzavg ! z average 536 536 !!---------------------------------------------------------------------- 537 537 INTEGER :: jk 538 REAL( wp) :: zdep538 REAL(dp) :: zdep 539 539 !!---------------------------------------------------------------------- 540 540 pzavg = 0.0 ; zdep = 0.0 … … 627 627 628 628 629 REAL( wp) FUNCTION icb_utl_yearday(kmon, kday, khr, kmin, ksec)629 REAL(dp) FUNCTION icb_utl_yearday(kmon, kday, khr, kmin, ksec) 630 630 !!---------------------------------------------------------------------- 631 631 !! *** FUNCTION icb_utl_yearday *** … … 830 830 831 831 832 REAL( wp) FUNCTION icb_utl_mass( first, justbits, justbergs )832 REAL(dp) FUNCTION icb_utl_mass( first, justbits, justbergs ) 833 833 !!---------------------------------------------------------------------- 834 834 !! *** FUNCTION icb_utl_mass *** … … 868 868 869 869 870 REAL( wp) FUNCTION icb_utl_heat( first, justbits, justbergs )870 REAL(dp) FUNCTION icb_utl_heat( first, justbits, justbergs ) 871 871 !!---------------------------------------------------------------------- 872 872 !! *** FUNCTION icb_utl_heat *** … … 916 916 !!---------------------------------------------------------------------- 917 917 INTEGER :: ikb 918 REAL( wp) :: zD, zout919 REAL( wp), DIMENSION(jpk) :: ze3, zin918 REAL(dp) :: zD, zout 919 REAL(dp), DIMENSION(jpk) :: ze3, zin 920 920 WRITE(numout,*) 'Test icb_utl_getkb : ' 921 921 zD = 0.0 ; ze3= 20.0
Note: See TracChangeset
for help on using the changeset viewer.
