Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbutl.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbutl.F90
r13281 r14789 8 8 !! - ! Removal of mapping from another grid 9 9 !! - ! 2011-04 (Alderson) Split into separate modules 10 !! 4.2 ! 2020-07 (P. Mathiot) simplification of interpolation routine 11 !! ! and add Nacho Merino work 10 12 !!---------------------------------------------------------------------- 11 13 12 14 !!---------------------------------------------------------------------- 13 15 !! icb_utl_interp : 14 !! icb_utl_bilin : 15 !! icb_utl_bilin_e : 16 !! icb_utl_pos : compute bottom left corner indice, weight and mask 17 !! icb_utl_bilin_h : interpolation field to icb position 18 !! icb_utl_bilin_e : interpolation of scale factor to icb position 16 19 !!---------------------------------------------------------------------- 17 20 USE par_oce ! ocean parameters 21 USE oce, ONLY: ts, uu, vv 18 22 USE dom_oce ! ocean domain 19 23 USE in_out_manager ! IO parameters … … 31 35 PRIVATE 32 36 37 INTERFACE icb_utl_bilin_h 38 MODULE PROCEDURE icb_utl_bilin_2d_h, icb_utl_bilin_3d_h 39 END INTERFACE 40 33 41 PUBLIC icb_utl_copy ! routine called in icbstp module 42 PUBLIC icb_utl_getkb ! routine called in icbdyn and icbthm modules 43 PUBLIC test_icb_utl_getkb ! routine called in icbdyn and icbthm modules 44 PUBLIC icb_utl_zavg ! routine called in icbdyn and icbthm modules 34 45 PUBLIC icb_utl_interp ! routine called in icbdyn, icbthm modules 35 PUBLIC icb_utl_bilin ! routine called in icbini, icbdyn modules 36 PUBLIC icb_utl_bilin_x ! routine called in icbdyn module 46 PUBLIC icb_utl_bilin_h ! routine called in icbdyn module 37 47 PUBLIC icb_utl_add ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 38 48 PUBLIC icb_utl_delete ! routine called in icblbc, icbthm modules … … 47 57 PUBLIC icb_utl_heat ! routine called in icbdia module 48 58 59 !! * Substitutions 60 # include "domzgr_substitute.h90" 49 61 !!---------------------------------------------------------------------- 50 62 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 54 66 CONTAINS 55 67 56 SUBROUTINE icb_utl_copy( )68 SUBROUTINE icb_utl_copy( Kmm ) 57 69 !!---------------------------------------------------------------------- 58 70 !! *** ROUTINE icb_utl_copy *** … … 62 74 !! ** Method : - blah blah 63 75 !!---------------------------------------------------------------------- 76 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp 64 77 #if defined key_si3 65 78 REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m ! ocean surface (ssh_m) if ice is not embedded 66 79 ! ! ocean surface in leads if ice is embedded 67 80 #endif 81 INTEGER :: jk ! vertical loop index 82 INTEGER :: Kmm ! ocean time levelindex 83 ! 68 84 ! copy nemo forcing arrays into iceberg versions with extra halo 69 85 ! only necessary for variables not on T points 70 86 ! and ssh which is used to calculate gradients 71 72 uo_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 73 vo_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 87 ! 88 ! surface forcing 89 ! 90 ssu_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 91 ssv_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 92 sst_e(1:jpi,1:jpj) = sst_m(:,:) 93 sss_e(1:jpi,1:jpj) = sss_m(:,:) 94 fr_e (1:jpi,1:jpj) = fr_i (:,:) 95 ua_e (1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 96 va_e (1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 74 97 ff_e(1:jpi,1:jpj) = ff_f (:,:) 75 tt_e(1:jpi,1:jpj) = sst_m(:,:) 76 ss_e(1:jpi,1:jpj) = sss_m(:,:) 77 fr_e(1:jpi,1:jpj) = fr_i (:,:) 78 ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 79 va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 80 ! 81 CALL lbc_lnk_icb( 'icbutl', uo_e, 'U', -1._wp, 1, 1 ) 82 CALL lbc_lnk_icb( 'icbutl', vo_e, 'V', -1._wp, 1, 1 ) 83 CALL lbc_lnk_icb( 'icbutl', ff_e, 'F', +1._wp, 1, 1 ) 84 CALL lbc_lnk_icb( 'icbutl', ua_e, 'U', -1._wp, 1, 1 ) 85 CALL lbc_lnk_icb( 'icbutl', va_e, 'V', -1._wp, 1, 1 ) 86 CALL lbc_lnk_icb( 'icbutl', fr_e, 'T', +1._wp, 1, 1 ) 87 CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 88 CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 98 ! 99 CALL lbc_lnk_icb( 'icbutl', ssu_e, 'U', -1._wp, 1, 1 ) 100 CALL lbc_lnk_icb( 'icbutl', ssv_e, 'V', -1._wp, 1, 1 ) 101 CALL lbc_lnk_icb( 'icbutl', ua_e , 'U', -1._wp, 1, 1 ) 102 CALL lbc_lnk_icb( 'icbutl', va_e , 'V', -1._wp, 1, 1 ) 89 103 #if defined key_si3 90 104 hi_e(1:jpi, 1:jpj) = hm_i (:,:) … … 96 110 ssh_e(1:jpi, 1:jpj) = zssh_lead_m(:,:) * tmask(:,:,1) 97 111 ! 98 CALL lbc_lnk_icb( 'icbutl', hi_e , 'T', +1._wp, 1, 1 )99 112 CALL lbc_lnk_icb( 'icbutl', ui_e , 'U', -1._wp, 1, 1 ) 100 113 CALL lbc_lnk_icb( 'icbutl', vi_e , 'V', -1._wp, 1, 1 ) 101 114 #else 102 ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 115 ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 103 116 #endif 104 CALL lbc_lnk_icb( 'icbutl', ssh_e, 'T', +1._wp, 1, 1 ) 117 ! 118 ! (PM) could be improve with a 3d lbclnk gathering both variables 119 ! should be done once extra haloe generalised 120 IF ( ln_M2016 ) THEN 121 DO jk = 1,jpk 122 ! uoce 123 ztmp(1:jpi,1:jpj) = uu(:,:,jk,Kmm) 124 CALL lbc_lnk_icb( 'icbutl', ztmp, 'U', -1._wp, 1, 1 ) 125 uoce_e(:,:,jk) = ztmp(:,:) 126 ! 127 ! voce 128 ztmp(1:jpi,1:jpj) = vv(:,:,jk,Kmm) 129 CALL lbc_lnk_icb( 'icbutl', ztmp, 'V', -1._wp, 1, 1 ) 130 voce_e(:,:,jk) = ztmp(:,:) 131 ! 132 e3t_e(1:jpi,1:jpj,jk) = e3t(:,:,jk,Kmm) 133 END DO 134 toce_e(1:jpi,1:jpj,:) = ts(:,:,:,1,Kmm) 135 END IF 105 136 ! 106 137 END SUBROUTINE icb_utl_copy 107 138 108 139 109 SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i, & 110 & pj, pe2, pvo, pvi, pva, pssh_j, & 111 & psst, pcn, phi, pff, psss ) 140 SUBROUTINE icb_utl_interp( pi, pj, pe1 , pssu, pui, pua, pssh_i, & 141 & pe2 , pssv, pvi, pva, pssh_j, & 142 & psst, psss, pcn, phi, pff , & 143 & plon, plat, ptoce, puoce, pvoce, pe3t ) 112 144 !!---------------------------------------------------------------------- 113 145 !! *** ROUTINE icb_utl_interp *** … … 127 159 !!---------------------------------------------------------------------- 128 160 REAL(wp), INTENT(in ) :: pi , pj ! position in (i,j) referential 129 REAL(wp), INTENT( out) :: pe1, pe2 ! i- and j scale factors 130 REAL(wp), INTENT( out) :: puo, pvo, pui, pvi, pua, pva ! ocean, ice and wind speeds 131 REAL(wp), INTENT( out) :: pssh_i, pssh_j ! ssh i- & j-gradients 132 REAL(wp), INTENT( out) :: psst, pcn, phi, pff, psss ! SST, ice concentration, ice thickness, Coriolis, SSS 133 ! 161 REAL(wp), INTENT( out), OPTIONAL :: pe1, pe2 ! i- and j scale factors 162 REAL(wp), INTENT( out), OPTIONAL :: pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds 163 REAL(wp), INTENT( out), OPTIONAL :: pssh_i, pssh_j ! ssh i- & j-gradients 164 REAL(wp), INTENT( out), OPTIONAL :: psst, psss, pcn, phi, pff ! SST, SSS, ice concentration, ice thickness, Coriolis 165 REAL(wp), INTENT( out), OPTIONAL :: plat, plon ! position 166 REAL(wp), DIMENSION(jpk), INTENT( out), OPTIONAL :: ptoce, puoce, pvoce, pe3t ! 3D variables 167 ! 168 REAL(wp), DIMENSION(4) :: zwT , zwU , zwV , zwF ! interpolation weight 169 REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 170 REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 171 REAL(wp), DIMENSION(4,jpk) :: zw1d 172 INTEGER :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 173 INTEGER :: iiTp, iiTm, ijTp, ijTm 134 174 REAL(wp) :: zcd, zmod ! local scalars 135 175 !!---------------------------------------------------------------------- 136 137 pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 138 pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 139 ! 140 puo = icb_utl_bilin_h( uo_e, pi, pj, 'U', .false. ) ! ocean velocities 141 pvo = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false. ) 142 psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true. ) ! SST 143 psss = icb_utl_bilin_h( ss_e, pi, pj, 'T', .true. ) ! SSS 144 pcn = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true. ) ! ice concentration 145 pff = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false. ) ! Coriolis parameter 146 ! 147 pua = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true. ) ! 10m wind 148 pva = icb_utl_bilin_h( va_e, pi, pj, 'V', .true. ) ! here (ua,va) are stress => rough conversion from stress to speed 149 zcd = 1.22_wp * 1.5e-3_wp ! air density * drag coefficient 150 zmod = 1._wp / MAX( 1.e-20, SQRT( zcd * SQRT( pua*pua + pva*pva) ) ) 151 pua = pua * zmod ! note: stress module=0 necessarly implies ua=va=0 152 pva = pva * zmod 153 176 ! 177 ! get position, weight and mask 178 CALL icb_utl_pos( pi, pj, 'T', iiT, ijT, zwT, zmskT ) 179 CALL icb_utl_pos( pi, pj, 'U', iiU, ijU, zwU, zmskU ) 180 CALL icb_utl_pos( pi, pj, 'V', iiV, ijV, zwV, zmskV ) 181 CALL icb_utl_pos( pi, pj, 'F', iiF, ijF, zwF, zmskF ) 182 ! 183 ! metrics and coordinates 184 IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 185 IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 186 IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true. ) 187 IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) 188 ! 189 IF ( PRESENT(pssu) ) pssu = icb_utl_bilin_h( ssu_e, iiU, ijU, zwU , .false. ) ! ocean velocities 190 IF ( PRESENT(pssv) ) pssv = icb_utl_bilin_h( ssv_e, iiV, ijV, zwV , .false. ) ! 191 IF ( PRESENT(psst) ) psst = icb_utl_bilin_h( sst_e, iiT, ijT, zwT * zmskT, .false. ) ! sst 192 IF ( PRESENT(psss) ) psss = icb_utl_bilin_h( sss_e, iiT, ijT, zwT * zmskT, .false. ) ! sss 193 IF ( PRESENT(pcn ) ) pcn = icb_utl_bilin_h( fr_e , iiT, ijT, zwT * zmskT, .false. ) ! ice concentration 194 IF ( PRESENT(pff ) ) pff = icb_utl_bilin_h( ff_e , iiF, ijF, zwF , .false. ) ! Coriolis parameter 195 ! 196 IF ( PRESENT(pua) .AND. PRESENT(pva) ) THEN 197 pua = icb_utl_bilin_h( ua_e, iiU, ijU, zwU * zmskU, .false. ) ! 10m wind 198 pva = icb_utl_bilin_h( va_e, iiV, ijV, zwV * zmskV, .false. ) ! here (ua,va) are stress => rough conversion from stress to speed 199 zcd = 1.22_wp * 1.5e-3_wp ! air density * drag coefficient 200 zmod = 1._wp / MAX( 1.e-20, SQRT( zcd * SQRT( pua*pua + pva*pva) ) ) 201 pua = pua * zmod ! note: stress module=0 necessarly implies ua=va=0 202 pva = pva * zmod 203 END IF 204 ! 154 205 #if defined key_si3 155 pui = icb_utl_bilin_h( ui_e , pi, pj, 'U', .false. )! sea-ice velocities156 pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V', .false. )157 phi = icb_utl_bilin_h( hi_e , pi, pj, 'T', .true. )! ice thickness206 IF ( PRESENT(pui) ) pui = icb_utl_bilin_h( ui_e , iiU, ijU, zwU , .false. ) ! sea-ice velocities 207 IF ( PRESENT(pvi) ) pvi = icb_utl_bilin_h( vi_e , iiV, ijV, zwV , .false. ) 208 IF ( PRESENT(phi) ) phi = icb_utl_bilin_h( hi_e , iiT, ijT, zwT * zmskT, .false. ) ! ice thickness 158 209 #else 159 pui = 0._wp160 pvi = 0._wp161 phi = 0._wp210 IF ( PRESENT(pui) ) pui = 0._wp 211 IF ( PRESENT(pvi) ) pvi = 0._wp 212 IF ( PRESENT(phi) ) phi = 0._wp 162 213 #endif 163 214 ! 164 215 ! Estimate SSH gradient in i- and j-direction (centred evaluation) 165 pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T', .true. ) - & 166 & icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T', .true. ) ) / ( 0.2_wp * pe1 ) 167 pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T', .true. ) - & 168 & icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T', .true. ) ) / ( 0.2_wp * pe2 ) 216 IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN 217 CALL icb_utl_pos( pi+0.1, pj , 'T', iiTp, ijTp, zwTp, zmskTp ) 218 CALL icb_utl_pos( pi-0.1, pj , 'T', iiTm, ijTm, zwTm, zmskTm ) 219 ! 220 IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 221 pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 222 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe1 ) 223 ! 224 CALL icb_utl_pos( pi , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp ) 225 CALL icb_utl_pos( pi , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm ) 226 ! 227 IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 228 pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 229 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe2 ) 230 END IF 231 ! 232 ! 3d interpolation 233 IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN 234 ! no need to mask as 0 is a valid data for land 235 zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ; 236 puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d ) 237 238 zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ; 239 pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d ) 240 END IF 241 242 IF ( PRESENT(ptoce) ) THEN 243 ! for temperature we need to mask the weight properly 244 ! no need of extra halo as it is a T point variable 245 zw1d(1,:) = tmask(iiT ,ijT ,:) * zwT(1) * zmskT(1) 246 zw1d(2,:) = tmask(iiT+1,ijT ,:) * zwT(2) * zmskT(2) 247 zw1d(3,:) = tmask(iiT ,ijT+1,:) * zwT(3) * zmskT(3) 248 zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4) 249 ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d ) 250 END IF 251 ! 252 IF ( PRESENT(pe3t) ) pe3t(:) = e3t_e(iiT,ijT,:) ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results 169 253 ! 170 254 END SUBROUTINE icb_utl_interp 171 255 172 173 REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type, plmask ) 256 SUBROUTINE icb_utl_pos( pi, pj, cd_type, kii, kij, pw, pmsk ) 174 257 !!---------------------------------------------------------------------- 175 258 !! *** FUNCTION icb_utl_bilin *** … … 182 265 !! 183 266 !!---------------------------------------------------------------------- 184 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated 185 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 186 CHARACTER(len=1) , INTENT(in) :: cd_type ! type of pfld array grid-points: = T , U , V or F points 187 LOGICAL , INTENT(in) :: plmask ! special treatment of mask point 188 ! 189 INTEGER :: ii, ij ! local integer 190 REAL(wp) :: zi, zj ! local real 191 REAL(wp) :: zw1, zw2, zw3, zw4 192 REAL(wp), DIMENSION(4) :: zmask 267 REAL(wp) , INTENT(IN) :: pi, pj ! targeted coordinates in (i,j) referential 268 CHARACTER(len=1) , INTENT(IN) :: cd_type ! point type 269 REAL(wp), DIMENSION(4), INTENT(OUT) :: pw, pmsk ! weight and mask 270 INTEGER , INTENT(OUT) :: kii, kij ! bottom left corner position in local domain 271 ! 272 REAL(wp) :: zwi, zwj ! distance to bottom left corner 273 INTEGER :: ierr 274 ! 193 275 !!---------------------------------------------------------------------- 194 276 ! … … 198 280 ! since we're looking for four T points containing quadrant we're in of 199 281 ! current T cell 200 ii = MAX(0, INT( pi))201 ij = MAX(0, INT( pj)) ! T-point202 z i = pi - REAL(ii,wp)203 z j = pj - REAL(ij,wp)282 kii = MAX(0, INT( pi )) 283 kij = MAX(0, INT( pj )) ! T-point 284 zwi = pi - REAL(kii,wp) 285 zwj = pj - REAL(kij,wp) 204 286 CASE ( 'U' ) 205 ii = MAX(0, INT( pi-0.5_wp ))206 ij = MAX(0, INT( pj)) ! U-point207 z i = pi - 0.5_wp - REAL(ii,wp)208 z j = pj - REAL(ij,wp)287 kii = MAX(0, INT( pi-0.5_wp )) 288 kij = MAX(0, INT( pj )) ! U-point 289 zwi = pi - 0.5_wp - REAL(kii,wp) 290 zwj = pj - REAL(kij,wp) 209 291 CASE ( 'V' ) 210 ii = MAX(0, INT( pi))211 ij = MAX(0, INT( pj-0.5_wp )) ! V-point212 z i = pi - REAL(ii,wp)213 z j = pj - 0.5_wp - REAL(ij,wp)292 kii = MAX(0, INT( pi )) 293 kij = MAX(0, INT( pj-0.5_wp )) ! V-point 294 zwi = pi - REAL(kii,wp) 295 zwj = pj - 0.5_wp - REAL(kij,wp) 214 296 CASE ( 'F' ) 215 ii = MAX(0, INT( pi-0.5_wp ))216 ij = MAX(0, INT( pj-0.5_wp )) ! F-point217 z i = pi - 0.5_wp - REAL(ii,wp)218 z j = pj - 0.5_wp - REAL(ij,wp)297 kii = MAX(0, INT( pi-0.5_wp )) 298 kij = MAX(0, INT( pj-0.5_wp )) ! F-point 299 zwi = pi - 0.5_wp - REAL(kii,wp) 300 zwj = pj - 0.5_wp - REAL(kij,wp) 219 301 END SELECT 302 ! 303 ! compute weight 304 pw(1) = (1._wp-zwi) * (1._wp-zwj) 305 pw(2) = zwi * (1._wp-zwj) 306 pw(3) = (1._wp-zwi) * zwj 307 pw(4) = zwi * zwj 308 ! 309 ! find position in this processor. Prevent near edge problems (see #1389) 310 ! 311 IF (TRIM(cd_type) == 'T' ) THEN 312 ierr = 0 313 IF ( kii < mig( 1 ) ) THEN ; ierr = ierr + 1 314 ELSEIF( kii >= mig(jpi) ) THEN ; ierr = ierr + 1 315 ENDIF 316 ! 317 IF ( kij < mjg( 1 ) ) THEN ; ierr = ierr + 1 318 ELSEIF( kij >= mjg(jpj) ) THEN ; ierr = ierr + 1 319 ENDIF 320 ! 321 IF ( ierr > 0 ) THEN 322 WRITE(numicb,*) 'bottom left corner T point out of bound' 323 WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi) 324 WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj) 325 WRITE(numicb,*) pmsk 326 CALL FLUSH(numicb) 327 CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).' , & 328 & 'This can be fixed using rn_speed_limit=0.4 in &namberg.' , & 329 & 'More details in the corresponding iceberg.stat file (nn_verbose_level > 0).' ) 330 END IF 331 END IF 220 332 ! 221 333 ! find position in this processor. Prevent near edge problems (see #1389) 222 334 ! (PM) will be useless if extra halo is used in NEMO 223 335 ! 224 IF ( ii <= mig(1)-1 ) THEN ;ii = 0225 ELSEIF( ii > mig(jpi) ) THEN ;ii = jpi226 ELSE ; ii = mi1(ii)336 IF ( kii <= mig(1)-1 ) THEN ; kii = 0 337 ELSEIF( kii > mig(jpi) ) THEN ; kii = jpi 338 ELSE ; kii = mi1(kii) 227 339 ENDIF 228 IF ( ij <= mjg(1)-1 ) THEN ;ij = 0229 ELSEIF( ij > mjg(jpj) ) THEN ;ij = jpj230 ELSE ; ij = mj1(ij)340 IF ( kij <= mjg(1)-1 ) THEN ; kij = 0 341 ELSEIF( kij > mjg(jpj) ) THEN ; kij = jpj 342 ELSE ; kij = mj1(kij) 231 343 ENDIF 232 344 ! 233 345 ! define mask array 234 IF (plmask) THEN 235 ! land value is not used in the interpolation 236 SELECT CASE ( cd_type ) 237 CASE ( 'T' ) 238 zmask = (/tmask_e(ii,ij), tmask_e(ii+1,ij), tmask_e(ii,ij+1), tmask_e(ii+1,ij+1)/) 239 CASE ( 'U' ) 240 zmask = (/umask_e(ii,ij), umask_e(ii+1,ij), umask_e(ii,ij+1), umask_e(ii+1,ij+1)/) 241 CASE ( 'V' ) 242 zmask = (/vmask_e(ii,ij), vmask_e(ii+1,ij), vmask_e(ii,ij+1), vmask_e(ii+1,ij+1)/) 243 CASE ( 'F' ) 244 ! F case only used for coriolis, ff_f is not mask so zmask = 1 245 zmask = 1. 246 END SELECT 247 ELSE 248 ! land value is used during interpolation 249 zmask = 1. 250 END iF 251 ! 252 ! compute weight 253 zw1 = zmask(1) * (1._wp-zi) * (1._wp-zj) 254 zw2 = zmask(2) * zi * (1._wp-zj) 255 zw3 = zmask(3) * (1._wp-zi) * zj 256 zw4 = zmask(4) * zi * zj 257 ! 258 ! compute interpolated value 259 icb_utl_bilin_h = ( pfld(ii,ij)*zw1 + pfld(ii+1,ij)*zw2 + pfld(ii,ij+1)*zw3 + pfld(ii+1,ij+1)*zw4 ) / MAX(1.e-20, zw1+zw2+zw3+zw4) 260 ! 261 END FUNCTION icb_utl_bilin_h 262 263 264 REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 346 ! land value is not used in the interpolation 347 SELECT CASE ( cd_type ) 348 CASE ( 'T' ) 349 pmsk = (/tmask_e(kii,kij), tmask_e(kii+1,kij), tmask_e(kii,kij+1), tmask_e(kii+1,kij+1)/) 350 CASE ( 'U' ) 351 pmsk = (/umask_e(kii,kij), umask_e(kii+1,kij), umask_e(kii,kij+1), umask_e(kii+1,kij+1)/) 352 CASE ( 'V' ) 353 pmsk = (/vmask_e(kii,kij), vmask_e(kii+1,kij), vmask_e(kii,kij+1), vmask_e(kii+1,kij+1)/) 354 CASE ( 'F' ) 355 ! F case only used for coriolis, ff_f is not mask so zmask = 1 356 pmsk = 1. 357 END SELECT 358 END SUBROUTINE icb_utl_pos 359 360 REAL(wp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon ) 265 361 !!---------------------------------------------------------------------- 266 362 !! *** FUNCTION icb_utl_bilin *** 267 363 !! 268 364 !! ** Purpose : bilinear interpolation at berg location depending on the grid-point type 365 !! this version deals with extra halo points 269 366 !! 270 367 !! !!gm CAUTION an optional argument should be added to handle … … 272 369 !! 273 370 !!---------------------------------------------------------------------- 274 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfld ! field to be interpolated 275 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 276 CHARACTER(len=1) , INTENT(in) :: cd_type ! type of pfld array grid-points: = T , U , V or F points 277 ! 278 INTEGER :: ii, ij ! local integer 279 REAL(wp) :: zi, zj ! local real 280 !!---------------------------------------------------------------------- 281 ! 282 SELECT CASE ( cd_type ) 283 CASE ( 'T' ) 284 ! note that here there is no +0.5 added 285 ! since we're looking for four T points containing quadrant we're in of 286 ! current T cell 287 ii = MAX(1, INT( pi )) 288 ij = MAX(1, INT( pj )) ! T-point 289 zi = pi - REAL(ii,wp) 290 zj = pj - REAL(ij,wp) 291 CASE ( 'U' ) 292 ii = MAX(1, INT( pi-0.5 )) 293 ij = MAX(1, INT( pj )) ! U-point 294 zi = pi - 0.5 - REAL(ii,wp) 295 zj = pj - REAL(ij,wp) 296 CASE ( 'V' ) 297 ii = MAX(1, INT( pi )) 298 ij = MAX(1, INT( pj-0.5 )) ! V-point 299 zi = pi - REAL(ii,wp) 300 zj = pj - 0.5 - REAL(ij,wp) 301 CASE ( 'F' ) 302 ii = MAX(1, INT( pi-0.5 )) 303 ij = MAX(1, INT( pj-0.5 )) ! F-point 304 zi = pi - 0.5 - REAL(ii,wp) 305 zj = pj - 0.5 - REAL(ij,wp) 306 END SELECT 307 ! 308 ! find position in this processor. Prevent near edge problems (see #1389) 309 IF ( ii < mig( 1 ) ) THEN ; ii = 1 310 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi 311 ELSE ; ii = mi1(ii) 371 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated 372 REAL(wp), DIMENSION(4) , INTENT(in) :: pw ! weight 373 LOGICAL , INTENT(in) :: pllon ! input data is a longitude 374 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 375 ! 376 REAL(wp), DIMENSION(4) :: zdat ! input data 377 !!---------------------------------------------------------------------- 378 ! 379 ! data 380 zdat(1) = pfld(pii ,pij ) 381 zdat(2) = pfld(pii+1,pij ) 382 zdat(3) = pfld(pii ,pij+1) 383 zdat(4) = pfld(pii+1,pij+1) 384 ! 385 IF( pllon .AND. MAXVAL(zdat) - MINVAL(zdat) > 90._wp ) THEN 386 WHERE( zdat < 0._wp ) zdat = zdat + 360._wp 312 387 ENDIF 313 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 314 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj 315 ELSE ; ij = mj1(ij) 316 ENDIF 317 ! 318 IF( ii == jpi ) ii = ii-1 319 IF( ij == jpj ) ij = ij-1 320 ! 321 icb_utl_bilin = ( pfld(ii,ij ) * (1.-zi) + pfld(ii+1,ij ) * zi ) * (1.-zj) & 322 & + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) * zj 323 ! 324 END FUNCTION icb_utl_bilin 325 326 327 REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj ) 328 !!---------------------------------------------------------------------- 329 !! *** FUNCTION icb_utl_bilin_x *** 388 ! 389 ! compute interpolated value 390 icb_utl_bilin_2d_h = ( zdat(1)*pw(1) + zdat(2)*pw(2) + zdat(3)*pw(3) + zdat(4)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4)) 391 ! 392 IF( pllon .AND. icb_utl_bilin_2d_h > 180._wp ) icb_utl_bilin_2d_h = icb_utl_bilin_2d_h - 360._wp 393 ! 394 END FUNCTION icb_utl_bilin_2d_h 395 396 FUNCTION icb_utl_bilin_3d_h( pfld, pii, pij, pw ) 397 !!---------------------------------------------------------------------- 398 !! *** FUNCTION icb_utl_bilin *** 330 399 !! 331 400 !! ** Purpose : bilinear interpolation at berg location depending on the grid-point type 332 !! Special case for interpolating longitude401 !! this version deals with extra halo points 333 402 !! 334 403 !! !!gm CAUTION an optional argument should be added to handle … … 336 405 !! 337 406 !!---------------------------------------------------------------------- 338 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfld ! field to be interpolated 339 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 340 ! 341 INTEGER :: ii, ij ! local integer 342 REAL(wp) :: zi, zj ! local real 343 REAL(wp) :: zret ! local real 344 REAL(wp), DIMENSION(4) :: z4 345 !!---------------------------------------------------------------------- 346 ! 347 ! note that here there is no +0.5 added 348 ! since we're looking for four T points containing quadrant we're in of 349 ! current T cell 350 ii = MAX(1, INT( pi )) 351 ij = MAX(1, INT( pj )) ! T-point 352 zi = pi - REAL(ii,wp) 353 zj = pj - REAL(ij,wp) 354 ! 355 ! find position in this processor. Prevent near edge problems (see #1389) 356 IF ( ii < mig( 1 ) ) THEN ; ii = 1 357 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi 358 ELSE ; ii = mi1(ii) 359 ENDIF 360 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 361 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj 362 ELSE ; ij = mj1(ij) 363 ENDIF 364 ! 365 IF( ii == jpi ) ii = ii-1 366 IF( ij == jpj ) ij = ij-1 367 ! 368 z4(1) = pfld(ii ,ij ) 369 z4(2) = pfld(ii+1,ij ) 370 z4(3) = pfld(ii ,ij+1) 371 z4(4) = pfld(ii+1,ij+1) 372 IF( MAXVAL(z4) - MINVAL(z4) > 90._wp ) THEN 373 WHERE( z4 < 0._wp ) z4 = z4 + 360._wp 374 ENDIF 375 ! 376 zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 377 IF( zret > 180._wp ) zret = zret - 360._wp 378 icb_utl_bilin_x = zret 379 ! 380 END FUNCTION icb_utl_bilin_x 381 407 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) :: pfld ! field to be interpolated 408 REAL(wp), DIMENSION(4,jpk) , INTENT(in) :: pw ! weight 409 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 410 REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 411 ! 412 REAL(wp), DIMENSION(4,jpk) :: zdat ! input data 413 INTEGER :: jk 414 !!---------------------------------------------------------------------- 415 ! 416 ! data 417 zdat(1,:) = pfld(pii ,pij ,:) 418 zdat(2,:) = pfld(pii+1,pij ,:) 419 zdat(3,:) = pfld(pii ,pij+1,:) 420 zdat(4,:) = pfld(pii+1,pij+1,:) 421 ! 422 ! compute interpolated value 423 DO jk=1,jpk 424 icb_utl_bilin_3d_h(jk) = ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) & 425 & / MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk)) 426 END DO 427 ! 428 END FUNCTION icb_utl_bilin_3d_h 382 429 383 430 REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) … … 390 437 !!---------------------------------------------------------------------- 391 438 REAL(wp), DIMENSION(:,:), INTENT(in) :: pet, peu, pev, pef ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts 392 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 393 ! 394 INTEGER :: ii, ij, icase, ierr ! local integer 439 REAL(wp) , INTENT(IN) :: pi , pj ! iceberg position 395 440 ! 396 441 ! weights corresponding to corner points of a T cell quadrant 397 442 REAL(wp) :: zi, zj ! local real 443 INTEGER :: ii, ij ! bottom left corner coordinate in local domain 398 444 ! 399 445 ! values at corner points of a T cell quadrant … … 402 448 !!---------------------------------------------------------------------- 403 449 ! 450 ! cannot used iiT because need ii/ij reltaive to global indices not local one 404 451 ii = MAX(1, INT( pi )) ; ij = MAX(1, INT( pj )) ! left bottom T-point (i,j) indices 405 452 ! 406 453 ! fractional box spacing 407 454 ! 0 <= zi < 0.5, 0 <= zj < 0.5 --> NW quadrant of current T cell … … 413 460 zj = pj - REAL(ij,wp) 414 461 415 ! find position in this processor. Prevent near edge problems (see #1389) 416 ! 417 ierr = 0 418 IF ( ii < mig( 1 ) ) THEN ; ii = 1 ; ierr = ierr + 1 419 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi ; ierr = ierr + 1 420 ELSE ; ii = mi1(ii) 421 ENDIF 422 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 ; ierr = ierr + 1 423 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj ; ierr = ierr + 1 424 ELSE ; ij = mj1(ij) 425 ENDIF 426 ! 427 IF( ii == jpi ) THEN ; ii = ii-1 ; ierr = ierr + 1 ; END IF 428 IF( ij == jpj ) THEN ; ij = ij-1 ; ierr = ierr + 1 ; END IF 429 ! 430 IF ( ierr > 0 ) CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error)') 462 ! conversion to local domain (no need to do a sanity check already done in icbpos) 463 ii = mi1(ii) 464 ij = mj1(ij) 431 465 ! 432 466 IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN … … 465 499 END FUNCTION icb_utl_bilin_e 466 500 501 SUBROUTINE icb_utl_getkb( kb, pe3, pD ) 502 !!---------------------------------------------------------------------- 503 !! *** ROUTINE icb_utl_getkb *** 504 !! 505 !! ** Purpose : compute the latest level affected by icb 506 !! 507 !!---------------------------------------------------------------------- 508 INTEGER, INTENT(out):: kb 509 REAL(wp), DIMENSION(:), INTENT(in) :: pe3 510 REAL(wp), INTENT(in) :: pD 511 !! 512 INTEGER :: jk 513 REAL(wp) :: zdepw 514 !!---------------------------------------------------------------------- 515 !! 516 zdepw = pe3(1) ; kb = 2 517 DO WHILE ( zdepw < pD) 518 zdepw = zdepw + pe3(kb) 519 kb = kb + 1 520 END DO 521 kb = MIN(kb - 1,jpk) 522 END SUBROUTINE 523 524 SUBROUTINE icb_utl_zavg(pzavg, pdat, pe3, pD, kb ) 525 !!---------------------------------------------------------------------- 526 !! *** ROUTINE icb_utl_getkb *** 527 !! 528 !! ** Purpose : compute the vertical average of ocean properties affected by icb 529 !! 530 !!---------------------------------------------------------------------- 531 INTEGER, INTENT(in ) :: kb ! deepest level affected by icb 532 REAL(wp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile 533 REAL(wp), INTENT(in ) :: pD ! draft 534 REAL(wp), INTENT(out) :: pzavg ! z average 535 !!---------------------------------------------------------------------- 536 INTEGER :: jk 537 REAL(wp) :: zdep 538 !!---------------------------------------------------------------------- 539 pzavg = 0.0 ; zdep = 0.0 540 DO jk = 1,kb-1 541 pzavg = pzavg + pe3(jk)*pdat(jk) 542 zdep = zdep + pe3(jk) 543 END DO 544 ! if kb is limited by mbkt => bottom value is used between bathy and icb tail 545 ! if kb not limited by mbkt => ocean value over mask is used (ie 0.0 for u, v) 546 pzavg = ( pzavg + (pD - zdep)*pdat(kb)) / pD 547 END SUBROUTINE 467 548 468 549 SUBROUTINE icb_utl_add( bergvals, ptvals ) … … 653 734 WRITE(numicb, 9200) kt, berg%number(1), & 654 735 pt%xi, pt%yj, pt%lon, pt%lat, pt%uvel, pt%vvel, & 655 pt% uo, pt%vo, pt%ua, pt%va, pt%ui, pt%vi736 pt%ssu, pt%ssv, pt%ua, pt%va, pt%ui, pt%vi 656 737 CALL flush( numicb ) 657 738 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4)) … … 679 760 WRITE(numicb,'(a," pe=(",i3,")")' ) cd_label, narea 680 761 WRITE(numicb,'(a8,4x,a6,12x,a5,15x,a7,19x,a3,17x,a5,17x,a5,17x,a5)' ) & 681 & 'timestep', 'number', 'xi,yj','lon,lat','u,v',' uo,vo','ua,va','ui,vi'762 & 'timestep', 'number', 'xi,yj','lon,lat','u,v','ssu,ssv','ua,va','ui,vi' 682 763 ENDIF 683 764 DO WHILE( ASSOCIATED(this) ) … … 823 904 END FUNCTION icb_utl_heat 824 905 906 SUBROUTINE test_icb_utl_getkb 907 !!---------------------------------------------------------------------- 908 !! *** FUNCTION test_icb_utl_getkb *** 909 !! 910 !! ** Purpose : Test routine icb_utl_getkb, icb_utl_zavg 911 !! ** Methode : Call each subroutine with specific input data 912 !! What should be the output is easy to determined and check 913 !! if NEMO return the correct answer. 914 !! ** Comments : not called, if needed a CALL test_icb_utl_getkb need to be added in icb_step 915 !!---------------------------------------------------------------------- 916 INTEGER :: ikb 917 REAL(wp) :: zD, zout 918 REAL(wp), DIMENSION(jpk) :: ze3, zin 919 WRITE(numout,*) 'Test icb_utl_getkb : ' 920 zD = 0.0 ; ze3= 20.0 921 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 922 CALL icb_utl_getkb(ikb, ze3, zD) 923 WRITE(numout,*) 'OUTPUT : kb = ',ikb 924 925 zD = 8000000.0 ; ze3= 20.0 926 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 927 CALL icb_utl_getkb(ikb, ze3, zD) 928 WRITE(numout,*) 'OUTPUT : kb = ',ikb 929 930 zD = 80.0 ; ze3= 20.0 931 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 932 CALL icb_utl_getkb(ikb, ze3, zD) 933 WRITE(numout,*) 'OUTPUT : kb = ',ikb 934 935 zD = 85.0 ; ze3= 20.0 936 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 937 CALL icb_utl_getkb(ikb, ze3, zD) 938 WRITE(numout,*) 'OUTPUT : kb = ',ikb 939 940 zD = 75.0 ; ze3= 20.0 941 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 942 CALL icb_utl_getkb(ikb, ze3, zD) 943 WRITE(numout,*) 'OUTPUT : kb = ',ikb 944 945 WRITE(numout,*) '==================================' 946 WRITE(numout,*) 'Test icb_utl_zavg' 947 zD = 0.0 ; ze3= 20.0 ; zin=1.0 948 CALL icb_utl_getkb(ikb, ze3, zD) 949 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 950 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 951 WRITE(numout,*) 'OUTPUT : zout = ',zout 952 953 zD = 50.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 954 CALL icb_utl_getkb(ikb, ze3, zD) 955 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 956 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 957 WRITE(numout,*) 'OUTPUT : zout = ',zout 958 CALL FLUSH(numout) 959 960 zD = 80.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 961 CALL icb_utl_getkb(ikb, ze3, zD) 962 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 963 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 964 WRITE(numout,*) 'OUTPUT : zout = ',zout 965 966 zD = 80 ; ze3= 20.0 ; zin=1.0 ; zin(3:jpk) = 0.0 967 CALL icb_utl_getkb(ikb, ze3, zD) 968 ikb = 2 969 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 970 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 971 WRITE(numout,*) 'OUTPUT : zout = ',zout 972 973 CALL FLUSH(numout) 974 975 END SUBROUTINE test_icb_utl_getkb 976 825 977 !!====================================================================== 826 978 END MODULE icbutl
Note: See TracChangeset
for help on using the changeset viewer.