Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcdcy.F90

Timestamp:

2021-11-26T12:27:56+01:00 (3 years ago)

Author:

sparonuz

Message:

Mixed precision version, tested up to 30 years on ORCA2.

File:

• NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcdcy.F90 (modified) (6 diffs)

NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcdcy.F90

@@ -30 +30 @@
    INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed
 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       -
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       -
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       -
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       -
 
    PUBLIC   sbc_dcy        ! routine called by sbc
@@ -73 +73 @@
       !!----------------------------------------------------------------------
       LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
-      REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle
+      REAL(dp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
+      REAL(dp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle
       !!
       INTEGER  ::   ji, jj                                       ! dummy loop indices
       INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
-      REAL(wp) ::   zlo, zup, zlousd, zupusd
-      REAL(wp) ::   ztmp, ztmp1, ztmp2
-      REAL(wp) ::   ztmpm, ztmpm1, ztmpm2
+      REAL(dp) ::   zlo, zup, zlousd, zupusd
+      REAL(dp) ::   ztmp, ztmp1, ztmp2
+      REAL(dp) ::   ztmpm, ztmpm1, ztmpm2
       !!---------------------------------------------------------------------
       !
@@ -163 +163 @@
       INTEGER  ::   ji, jj                                       ! dummy loop indices
       !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
-      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
-      REAL(wp) ::   ztmp, ztest
+      REAL(dp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(dp) ::   ztmp, ztest
       !---------------------------statement functions------------------------
       !
@@ -236 +236 @@
                ELSE                                         ! day time in two parts
                   IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN
-                     rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
-                        &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                     rscal(ji,jj) = fintegral(0._dp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                        &         + fintegral(rdawn_dcy(ji,jj), 1._dp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
                      rscal(ji,jj) = 1. / rscal(ji,jj)
                   ENDIF
@@ -243 +243 @@
             ELSE
                IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
-                  rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  rscal(ji,jj) = fintegral(0._dp, 1._dp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
                   rscal(ji,jj) = 1._wp / rscal(ji,jj)
                ELSE                                          ! No day
@@ -260 +260 @@
 
    FUNCTION fintegral( pt1, pt2, paaa, pbbb, pccc )
-      REAL(wp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc
-      REAL(wp) :: fintegral
+      REAL(dp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc
+      REAL(dp) :: fintegral
       fintegral =   paaa * pt2 + 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt2)   &
          &        - paaa * pt1 - 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt1)