Changeset 13181 for NEMO/branches/2020
- Timestamp:
- 2020-06-30T15:57:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icethd_dh.F90
r12546 r13181 442 442 443 443 zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0) 444 & - rLfus * ( 1.0 - ztmelts / ( zt_i_new - rt0) ) + rcp * ztmelts444 & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 445 445 446 446 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icevar.F90
r12489 r13181 635 635 !!------------------------------------------------------------------- 636 636 ! 637 WHERE( pa_i (1:npti,:) < 0._wp .AND. pa_i (1:npti,:) > -epsi10 ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 638 WHERE( pv_i (1:npti,:) < 0._wp .AND. pv_i (1:npti,:) > -epsi10 ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 639 WHERE( pv_s (1:npti,:) < 0._wp .AND. pv_s (1:npti,:) > -epsi10 ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 640 WHERE( psv_i(1:npti,:) < 0._wp .AND. psv_i(1:npti,:) > -epsi10 ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 641 WHERE( poa_i(1:npti,:) < 0._wp .AND. poa_i(1:npti,:) > -epsi10 ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 642 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 643 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 637 638 WHERE( pa_i (1:npti,:) < 0._wp ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 639 WHERE( pv_i (1:npti,:) < 0._wp ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 640 WHERE( pv_s (1:npti,:) < 0._wp ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 641 WHERE( psv_i(1:npti,:) < 0._wp ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 642 WHERE( poa_i(1:npti,:) < 0._wp ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 643 WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 644 WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 644 645 IF( ln_pnd_H12 ) THEN 645 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0646 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0646 WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 647 WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 647 648 ENDIF 648 649 ! -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icblbc.F90
r12377 r13181 81 81 TYPE(iceberg), POINTER :: this 82 82 TYPE(point) , POINTER :: pt 83 INTEGER :: iine84 83 !!---------------------------------------------------------------------- 85 84 … … 92 91 DO WHILE( ASSOCIATED(this) ) 93 92 pt => this%current_point 94 iine = INT( pt%xi + 0.5 ) 95 IF( iine > mig(nicbei) ) THEN 93 IF( pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN 96 94 pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp 97 ELSE IF( iine < mig(nicbdi)) THEN95 ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 98 96 pt%xi = ricb_left + MOD(pt%xi, 1._wp ) 99 97 ENDIF … … 128 126 pt => this%current_point 129 127 ijne = INT( pt%yj + 0.5 ) 130 IF( ijne .GT. mjg(nicbej)) THEN128 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 131 129 ! 132 130 iine = INT( pt%xi + 0.5 ) … … 170 168 INTEGER :: ibergs_rcvd_from_n, ibergs_rcvd_from_s 171 169 INTEGER :: i, ibergs_start, ibergs_end 172 INTEGER :: iine, ijne173 170 INTEGER :: ipe_N, ipe_S, ipe_W, ipe_E 174 171 REAL(wp), DIMENSION(2) :: zewbergs, zwebergs, znsbergs, zsnbergs … … 234 231 DO WHILE (ASSOCIATED(this)) 235 232 pt => this%current_point 236 iine = INT( pt%xi + 0.5 ) 237 IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN 233 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN 238 234 tmpberg => this 239 235 this => this%next … … 248 244 CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 249 245 CALL icb_utl_delete(first_berg, tmpberg) 250 ELSE IF( ipe_W >= 0 .AND. iine < mig(nicbdi)) THEN246 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 251 247 tmpberg => this 252 248 this => this%next … … 372 368 DO WHILE (ASSOCIATED(this)) 373 369 pt => this%current_point 374 ijne = INT( pt%yj + 0.5 ) 375 IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN 370 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 376 371 tmpberg => this 377 372 this => this%next … … 383 378 CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 384 379 CALL icb_utl_delete(first_berg, tmpberg) 385 ELSE IF( ipe_S >= 0 .AND. ijne .LT. mjg(nicbdj)) THEN380 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN 386 381 tmpberg => this 387 382 this => this%next … … 539 534 DO WHILE (ASSOCIATED(this)) 540 535 pt => this%current_point 541 iine = INT( pt%xi + 0.5 ) 542 ijne = INT( pt%yj + 0.5 ) 543 IF( iine .LT. mig(nicbdi) .OR. & 544 iine .GT. mig(nicbei) .OR. & 545 ijne .LT. mjg(nicbdj) .OR. & 546 ijne .GT. mjg(nicbej)) THEN 536 IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp .OR. & 537 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp .OR. & 538 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp .OR. & 539 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 547 540 i = i + 1 548 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) ,iine,ijne541 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) 549 542 WRITE(numicb,*) ' ', nimpp, njmpp 550 543 WRITE(numicb,*) ' ', nicbdi, nicbei, nicbdj, nicbej … … 614 607 pt => this%current_point 615 608 iine = INT( pt%xi + 0.5 ) 616 ijne = INT( pt%yj + 0.5 )617 609 iproc = nicbflddest(mi1(iine)) 618 IF( ijne .GT. mjg(nicbej)) THEN610 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 619 611 IF( iproc == ifldproc ) THEN 620 612 ! … … 696 688 ipts = nicbfldpts (mi1(iine)) 697 689 iproc = nicbflddest(mi1(iine)) 698 IF( ijne .GT. mjg(nicbej)) THEN690 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 699 691 IF( iproc == ifldproc ) THEN 700 692 ! -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lib_mpp.F90
r13135 r13181 261 261 !! 262 262 INTEGER :: iflag 263 !!---------------------------------------------------------------------- 264 ! 265 #if defined key_mpp_mpi 266 CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 263 INTEGER :: mpi_working_type 264 !!---------------------------------------------------------------------- 265 ! 266 #if defined key_mpp_mpi 267 IF (wp == dp) THEN 268 mpi_working_type = mpi_double_precision 269 ELSE 270 mpi_working_type = mpi_real 271 END IF 272 CALL mpi_isend( pmess, kbytes, mpi_working_type, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 267 273 #endif 268 274 ! … … 331 337 INTEGER :: iflag 332 338 INTEGER :: use_source 339 INTEGER :: mpi_working_type 333 340 !!---------------------------------------------------------------------- 334 341 ! … … 339 346 IF( PRESENT(ksource) ) use_source = ksource 340 347 ! 341 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 348 IF (wp == dp) THEN 349 mpi_working_type = mpi_double_precision 350 ELSE 351 mpi_working_type = mpi_real 352 END IF 353 CALL mpi_recv( pmess, kbytes, mpi_working_type, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 342 354 #endif 343 355 ! -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/grt_cir_dis.h90
r10068 r13181 28 28 REAL(KIND=wp) :: pc2 ! cos(lat2) * sin(lon2) 29 29 30 REAL(KIND=wp) :: cosdist ! cosine of great circle distance 31 32 ! Compute cosine of great circle distance, constraining it to be between 33 ! -1 and 1 (rounding errors can take it slightly outside this range 34 cosdist = MAX( MIN( pa1 * pa2 + pb1 * pb2 + pc1 * pc2, 1.0_wp), -1.0_wp ) 35 30 36 grt_cir_dis = & 31 & ASIN( SQRT( 1.0 - ( pa1 * pa2 + pb1 * pb2 + pc1 * pc2 )**2) )37 & ASIN( SQRT( 1.0_wp - cosdist**2.0_wp ) ) 32 38 33 39 END FUNCTION grt_cir_dis -
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/obsinter_z1d.h90
r10068 r13181 62 62 z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep) ) 63 63 z1dp = ( pobsdep(jdep) - pdep(kkco(jdep)-1) ) 64 IF ( pobsmask(kkco(jdep)) == 0.0_wp ) z1dp = 0.0_wp 64 65 ! If kkco(jdep) is masked then set pobs(jdep) to the lowest value located above bathymetry 66 IF ( pobsmask(kkco(jdep)) == 0.0_wp ) THEN 67 pobs(jdep) = pobsk(kkco(jdep)-1) 68 ELSE 69 zsum = z1dm + z1dp 65 70 66 zsum = z1dm + z1dp 67 68 IF ( k1dint == 0 ) THEN 71 IF ( k1dint == 0 ) THEN 69 72 70 !-----------------------------------------------------------------71 ! Linear interpolation72 !-----------------------------------------------------------------73 pobs(jdep) = ( z1dm * pobsk(kkco(jdep)-1) &74 & + z1dp * pobsk(kkco(jdep) ) ) / zsum73 !----------------------------------------------------------------- 74 ! Linear interpolation 75 !----------------------------------------------------------------- 76 pobs(jdep) = ( z1dm * pobsk(kkco(jdep)-1) & 77 & + z1dp * pobsk(kkco(jdep) ) ) / zsum 75 78 76 ELSEIF ( k1dint == 1 ) THEN79 ELSEIF ( k1dint == 1 ) THEN 77 80 78 !-----------------------------------------------------------------79 ! Cubic spline interpolation80 !-----------------------------------------------------------------81 zsum2 = zsum * zsum82 pobs(jdep) = ( z1dm * pobsk (kkco(jdep)-1) &83 & + z1dp * pobsk (kkco(jdep) ) &84 & + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) &85 & + z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep) ) &86 & ) / 6.0_wp &87 & ) / zsum81 !----------------------------------------------------------------- 82 ! Cubic spline interpolation 83 !----------------------------------------------------------------- 84 zsum2 = zsum * zsum 85 pobs(jdep) = ( z1dm * pobsk (kkco(jdep)-1) & 86 & + z1dp * pobsk (kkco(jdep) ) & 87 & + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) & 88 & + z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep) ) & 89 & ) / 6.0_wp & 90 & ) / zsum 88 91 92 ENDIF 89 93 ENDIF 90 94 END DO
Note: See TracChangeset
for help on using the changeset viewer.