New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13181 for NEMO/branches – NEMO

Changeset 13181 for NEMO/branches


Ignore:
Timestamp:
2020-06-30T15:57:34+02:00 (4 years ago)
Author:
orioltp
Message:

Several bugfixes added by Sam Hatfield (ECMWF).

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  
    442442                
    443443               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  * ztmelts 
     444                  &            - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp  * ztmelts 
    445445 
    446446               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  
    635635      !!------------------------------------------------------------------- 
    636636      ! 
    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 
    644645      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 >= 0 
    646          WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     646         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 
    647648      ENDIF 
    648649      ! 
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icblbc.F90

    r12377 r13181  
    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/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lib_mpp.F90

    r13135 r13181  
    261261      !! 
    262262      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 ) 
    267273#endif 
    268274      ! 
     
    331337      INTEGER :: iflag 
    332338      INTEGER :: use_source 
     339      INTEGER :: mpi_working_type 
    333340      !!---------------------------------------------------------------------- 
    334341      ! 
     
    339346      IF( PRESENT(ksource) )   use_source = ksource 
    340347      ! 
    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 ) 
    342354#endif 
    343355      ! 
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/grt_cir_dis.h90

    r10068 r13181  
    2828      REAL(KIND=wp) :: pc2   !  cos(lat2) * sin(lon2) 
    2929 
     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 
    3036      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 ) ) 
    3238       
    3339   END FUNCTION grt_cir_dis 
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/obsinter_z1d.h90

    r10068 r13181  
    6262         z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep)      ) 
    6363         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 
    6570 
    66          zsum = z1dm + z1dp 
    67           
    68          IF ( k1dint == 0 ) THEN 
     71            IF ( k1dint == 0 ) THEN 
    6972 
    70             !----------------------------------------------------------------- 
    71             !  Linear interpolation 
    72             !----------------------------------------------------------------- 
    73             pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) & 
    74                &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum 
     73               !----------------------------------------------------------------- 
     74               !  Linear interpolation 
     75               !----------------------------------------------------------------- 
     76               pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) & 
     77                  &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum 
    7578 
    76          ELSEIF ( k1dint == 1 ) THEN 
     79            ELSEIF ( k1dint == 1 ) THEN 
    7780 
    78             !----------------------------------------------------------------- 
    79             ! Cubic spline interpolation 
    80             !----------------------------------------------------------------- 
    81             zsum2 = zsum * zsum 
    82             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                &          ) / zsum 
     81               !----------------------------------------------------------------- 
     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 
    8891 
     92            ENDIF 
    8993         ENDIF 
    9094      END DO 
Note: See TracChangeset for help on using the changeset viewer.