Ignore:
Timestamp:
2020-07-02T16:24:31+02:00 (7 months ago)
Author:
orioltp
Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

Location:
NEMO/trunk/src/OCE/ICB
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/ICB/icblbc.F90

    r12377 r13226  
    8181      TYPE(iceberg), POINTER ::   this 
    8282      TYPE(point)  , POINTER ::   pt 
    83       INTEGER                ::   iine 
    8483      !!---------------------------------------------------------------------- 
    8584 
     
    9291         DO WHILE( ASSOCIATED(this) ) 
    9392            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 
    9694               pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp 
    97             ELSE IF( iine < mig(nicbdi) ) THEN 
     95            ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 
    9896               pt%xi = ricb_left + MOD(pt%xi, 1._wp ) 
    9997            ENDIF 
     
    128126         pt => this%current_point 
    129127         ijne = INT( pt%yj + 0.5 ) 
    130          IF( ijne .GT. mjg(nicbej) ) THEN 
     128         IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
    131129            ! 
    132130            iine = INT( pt%xi + 0.5 ) 
     
    170168      INTEGER                             ::   ibergs_rcvd_from_n, ibergs_rcvd_from_s 
    171169      INTEGER                             ::   i, ibergs_start, ibergs_end 
    172       INTEGER                             ::   iine, ijne 
    173170      INTEGER                             ::   ipe_N, ipe_S, ipe_W, ipe_E 
    174171      REAL(wp), DIMENSION(2)              ::   zewbergs, zwebergs, znsbergs, zsnbergs 
     
    234231         DO WHILE (ASSOCIATED(this)) 
    235232            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 
    238234               tmpberg => this 
    239235               this => this%next 
     
    248244               CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 
    249245               CALL icb_utl_delete(first_berg, tmpberg) 
    250             ELSE IF( ipe_W >= 0 .AND. iine < mig(nicbdi) ) THEN 
     246            ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 
    251247               tmpberg => this 
    252248               this => this%next 
     
    372368         DO WHILE (ASSOCIATED(this)) 
    373369            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 
    376371               tmpberg => this 
    377372               this => this%next 
     
    383378               CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 
    384379               CALL icb_utl_delete(first_berg, tmpberg) 
    385             ELSE IF( ipe_S >= 0 .AND. ijne .LT. mjg(nicbdj) ) THEN 
     380            ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN 
    386381               tmpberg => this 
    387382               this => this%next 
     
    539534         DO WHILE (ASSOCIATED(this)) 
    540535            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 
    547540               i = i + 1 
    548                WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne 
     541               WRITE(numicb,*) 'berg lost in halo: ', this%number(:) 
    549542               WRITE(numicb,*) '                   ', nimpp, njmpp 
    550543               WRITE(numicb,*) '                   ', nicbdi, nicbei, nicbdj, nicbej 
     
    614607                  pt => this%current_point 
    615608                  iine = INT( pt%xi + 0.5 ) 
    616                   ijne = INT( pt%yj + 0.5 ) 
    617609                  iproc = nicbflddest(mi1(iine)) 
    618                   IF( ijne .GT. mjg(nicbej) ) THEN 
     610                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
    619611                     IF( iproc == ifldproc ) THEN 
    620612                        ! 
     
    696688                  ipts  = nicbfldpts (mi1(iine)) 
    697689                  iproc = nicbflddest(mi1(iine)) 
    698                   IF( ijne .GT. mjg(nicbej) ) THEN 
     690                  IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 
    699691                     IF( iproc == ifldproc ) THEN 
    700692                        ! 
  • NEMO/trunk/src/OCE/ICB/icbthm.F90

    r12291 r13226  
    5757      TYPE(point)  , POINTER ::   pt 
    5858      ! 
    59       COMPLEX(wp), DIMENSION(jpi,jpj) :: cicb_melt, cicb_hflx 
     59      COMPLEX(dp), DIMENSION(jpi,jpj) :: cicb_melt, cicb_hflx 
    6060      !!---------------------------------------------------------------------- 
    6161      ! 
    6262      !! initialiaze cicb_melt and cicb_heat 
    63       cicb_melt = CMPLX( 0.e0, 0.e0, wp )  
    64       cicb_hflx = CMPLX( 0.e0, 0.e0, wp )  
     63      cicb_melt = CMPLX( 0.e0, 0.e0, dp )  
     64      cicb_hflx = CMPLX( 0.e0, 0.e0, dp )  
    6565      ! 
    6666      z1_rday = 1._wp / rday 
     
    176176            !! the use of DDPDD function for the cumulative sum is needed for reproducibility 
    177177            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s 
    178             CALL DDPDD( CMPLX( zmelt * z1_e1e2, 0.e0, wp ), cicb_melt(ii,ij) ) 
     178            CALL DDPDD( CMPLX( zmelt * z1_e1e2, 0.e0, dp ), cicb_melt(ii,ij) ) 
    179179            ! 
    180180            ! iceberg heat flux 
     
    185185            zheat_hcflux = zmelt * pt%heat_density       ! heat content flux : kg/s x J/kg = J/s 
    186186            zheat_latent = - zmelt * rLfus               ! latent heat flux:  kg/s x J/kg = J/s 
    187             CALL DDPDD( CMPLX( ( zheat_hcflux + zheat_latent ) * z1_e1e2, 0.e0, wp ), cicb_hflx(ii,ij) ) 
     187            CALL DDPDD( CMPLX( ( zheat_hcflux + zheat_latent ) * z1_e1e2, 0.e0, dp ), cicb_hflx(ii,ij) ) 
    188188            ! 
    189189            ! diagnostics 
     
    230230      END DO 
    231231      ! 
    232       berg_grid%floating_melt = REAL(cicb_melt,wp)    ! kg/m2/s 
    233       berg_grid%calving_hflx  = REAL(cicb_hflx,wp) 
     232      berg_grid%floating_melt = REAL(cicb_melt,dp)    ! kg/m2/s 
     233      berg_grid%calving_hflx  = REAL(cicb_hflx,dp) 
    234234      ! 
    235235      ! now use melt and associated heat flux in ocean (or not) 
Note: See TracChangeset for help on using the changeset viewer.